MM法Excelマクロソース《投資の杜》

MM法.xls Module1　ソース選択

'=======================================================================================
'MM法売買サイン点灯銘柄抽出マクロ（MM法.xls）                         v0.0 2005.12.18版
'                  by 投資の杜（http://stock.kikuchisan.net/）
'=======================================================================================
'【利用条件】
'　(1)マクロをダウンロードした時点で以下の利用条件に同意したものとみなします
'　(2)当マクロの著作権は作者に帰属します。営利を目的としない個人や法人（非営利団体・
'　　 官公庁を含む）で使用の場合は無料で提供しています。マクロの改造は自由ですが、
'　　 再配布・商用利用の場合は作者の許可が必要です
'　(3)このマクロの配布にあたってはその有用性等に関するいかなる保証も行ないません。この
'　　 マクロの使用に際して生じたいかなる損害に対しても作者は責任を負いません。ご自身の
'　　 判断と責任においてご利用ください
'　(4)このマクロに明らかな不具合・仕様上の不備等が見つかった場合においても作者はそれを
'　　 修正する責を負いません
'【マクロ説明】
'　キッチンカブー「ボリンジャーバンド±2σ」銘柄一覧(東証)をWebから取得してその銘柄毎の
'　株価時系列データをYahooファイナンスからWeb取得し、MM法の抽出条件で絞り込みを行い売買
'　サイン点灯銘柄一覧を作成するマクロです
'【機能】
'　主機能　  (1)買売銘柄抽出 (2)指定銘柄解析 (3)銘柄リスト解析
'  補助機能　(a)抽出条件変更 (b)銘柄リスト保存
'【使用方法】
'　(1)インターネットに接続後MM法.xlsを「マクロを有効にする」を選択してExcelで開きます
'　(2)ワークシートメニューに「MM法」が追加されるのでこのメニューから機能選択をします
'　(3)銘柄・株価を自動取得しMM法.xlsと同じフォルダーに一覧データ(xls,html)を作成します
'【抽出条件】
'　(1)買サイン⇒ボリンジャー(20日)＜-2σ & RSI(13日)＜25％ & ADX(DMI14日,ADX1日)＞75％
'　(2)売サイン⇒ボリンジャー(20日)＞+2σ & RSI(13日)＞75％ & ADX(DMI14日,ADX1日)＞75％
'【解析パラメータ】
'　(1)MACD(5日-20日)、MACDシグナル(9日)、クロス：MACD－MACDシグナル
'　(2)RRR値=利幅/損切幅（利幅=|ボリンジャー±2σ値-移動平均値|,損切幅=終値x5%）(＞2.5倍)
'　(3)出来比：前5日間の出来高平均に対する出来高の倍率（＞4倍）
'　(4)終値比：終値の騰落率、マイナスは下落（＞±4％）
'　(5)乖離率：終値の25日移動平均線からの放れ度合（＞±15％）
'　(6)売買代金（銘柄名）：出来高x終値（＞10億円以上）
'【データ取得サイト】
'  (1)キッチンカブー「指標別売買サイン（東証）」
'  (2)Yahoo！ファイナンス「株価時系列データ 」「今日の値動き」
'【マクロ作成参考サイト】
'  (1)指標計算---協栄物産さんのテクニカル分析講座「表計算ソフトでの計算式の置き方」
'  (2)株価取得---Excelで株投資さんの「Webから株価データ取得マクロ」
'=======================================================================================
Option Explicit
'変数の宣言
Const KABOO As String = "URL;http://www.kaboo.co.jp/baibai/"
Const YAHOO As String = "URL;http://table.yahoo.co.jp/"
Const YAHOO1 As String = "http://quote.yahoo.co.jp/q?s="  '銘柄リンク用
Const YAHOO2 As String = ".t&d=c&k=c3&a=v,r14,m26-12-9&p=m25,m75,s,b&t=3m&l=off&z=m&q=c"
Dim 取得開始日 As Date, 取得終了日 As Date            '取得開始・終了日
Dim 計算日, ファイル日付 As Variant                   '日付(yyyy/mm/dd)、日付(yyyymmdd)
Dim 買売, 抽出数, 買データ数, 売データ数 As Variant   '抽出方法、抽出数、データ数
Dim 記録最終行, 取得最終行 As Variant                 'データ最終行
Dim 取得位置, 取得フラグ As Variant                   'WebTables値、正常取得判定
Public 銘柄コード, 指標 As Variant                    '銘柄コード・算出指標
Public RSI買 As Integer, RSI売 As Integer, ADX買売 As Integer '抽出判定値(Workbook_Open())
Sub 買売一括抽出()
    Call 解析1("borin-2.htm", "")
    Call 解析1("borin+2.htm", "")
    Call 解析2("")
End Sub
Sub 買銘柄抽出()
    Call 解析1("borin-2.htm", "")
    Call 解析2("買")
End Sub
Sub 売銘柄抽出()
    Call 解析1("borin+2.htm", "")
    Call 解析2("売")
End Sub
Sub 指定銘柄解析()
    UserForm1.Show    'ユーザーフォームで銘柄コード,指標取得
    If 銘柄コード <> "" And 指標 <> "" Then
        Call 解析1("borin-2.htm", 指標)
        Call 解析2("指定")
    End If
End Sub
Sub 銘柄リスト解析()
    Call 解析1("borin-2.htm", "外部")
    Call 解析1("borin+2.htm", "外部")
    Call 解析2("")
End Sub
Sub 銘柄リスト保存()
    Application.ScreenUpdating = False  '画面更新非表示
    Application.DisplayAlerts = False   '警告メッセージ非表示
'買銘柄リスト保存
    Call カブーデータ("borin-2.htm")
    Call 日付作成(買売)
        Columns("C:M").Select    '不要行列の削除
        Selection.Delete Shift:=xlToLeft
    Call ファイル出力("txt", "買")
'売銘柄リスト保存
    Call カブーデータ("borin+2.htm")
    Call 日付作成(買売)
        Columns("C:M").Select    '不要行列の削除
        Selection.Delete Shift:=xlToLeft
    Call ファイル出力("txt", "売")
'終了処理
    Worksheets("Sheet3").Activate
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
End Sub
Sub 抽出条件変更()
    UserForm2.Show    'ユーザーフォームで抽出条件を設定
End Sub
Sub 投資の杜Webページ()
    Shell "EXPLORER.EXE http://stock.kikuchisan.net/mmsign.html"
End Sub
Sub 解析1(買売, 指標)
    Dim rc, i, マス数, 有無, myst, d11y, d11m, d11d As Variant
'初期設定
    Application.ScreenUpdating = False  '画面更新非表示
    Application.DisplayAlerts = False   '警告メッセージ非表示
'過去データ("Sheet1")削除
    Worksheets("Sheet1").Activate
        Columns("A:N").Select
        Selection.Delete Shift:=xlToLeft
    Cells.Select
    With Selection
        .Font.Name = "MS UI Gothic"
        .Font.Size = 11
        .HorizontalAlignment = xlGeneral
    End With
    Range("A1").Select
'項目名
    Application.ScreenUpdating = True   '画面更新表示
    Cells(3, 1) = "コード"
    Cells(3, 2) = "銘柄名"
    Cells(3, 3) = "出来高"
    Cells(3, 4) = "終値"
    Cells(3, 5) = "ボリン"
    Cells(3, 6) = "RSI"
    Cells(3, 7) = "ADX"
    Cells(3, 8) = "MACD"
    Cells(3, 9) = "シグナル"
    Cells(3, 10) = "クロス"
    Cells(3, 11) = "RRR"
    Cells(3, 12) = "出来比"
    Cells(3, 13) = "終値比"
    Cells(3, 14) = "乖離率"
    Application.ScreenUpdating = False  '画面更新非表示

'買売銘柄抽出、銘柄指定解析の場合
    If 指標 <> "外部" Then
    'カブーデータ取得(Sheet3)
        Call カブーデータ(買売)
        Cells(5000, 1).End(xlUp).Select
            rc = ActiveCell.Row       '行末からの最終行取得
    '抽出名設定
        買売 = Replace(買売, "borin-2.htm", "買")
        買売 = Replace(買売, "borin+2.htm", "売")
    '銘柄指定解析の場合はSheet3に銘柄コード、銘柄名を設定
        If 銘柄コード <> "" And 指標 <> "" Then
            Worksheets("Sheet3").Cells(4, 1) = 銘柄コード
            Call 時系列データ(銘柄コード, "10")    '銘柄コードから銘柄名取得
            Worksheets("Sheet3").Cells(4, 2) = Worksheets("Sheet2").Cells(1, 1)
            rc = 4                     'データ最終行数
            買売 = "指定"              '抽出名設定
            Sheets("Sheet3").Select    '不要行列の削除
            Columns("C:M").Select
            Selection.Delete Shift:=xlToLeft
            Rows("5:5000").Select
            Selection.Delete Shift:=xlUp
            Range("A1").Select
        End If
    Else
'銘柄リスト解析の場合
    '抽出名設定
        買売 = Replace(買売, "borin-2.htm", "買")
        買売 = Replace(買売, "borin+2.htm", "売")
        Call 銘柄リスト読込(買売)
        Cells(5000, 1).End(xlUp).Select
            rc = ActiveCell.Row       '行末からの最終行取得
    End If

'日付作成
    Call 日付作成(買売)
'買売銘柄抽出の場合は銘柄リスト保存
    If 指標 = "" Then
        Sheets("Sheet3").Select    '不要列の削除
        Columns("C:M").Select
        Selection.Delete Shift:=xlToLeft
        Call ファイル出力("txt", 買売)
    End If

'テスト用
'If 買売 = "買" Then rc = 5
'If 買売 = "売" Then rc = 6

'銘柄毎のYahooデータ取得(Sheet2)＆指標計算(Sheet1)
    取得フラグ = 0    '0=正常,1=異常
    For i = 4 To rc Step 1
        銘柄コード = Worksheets("Sheet3").Cells(i, 1)
    'プログレスバー表示
        マス数 = i / rc * 10.2
        Application.StatusBar = 買売 & "抽出" & String(マス数, "■") & String(10 - マス数, "□") _
            & "---" & i - 3 & "/" & rc - 3 & " [銘柄 " & 銘柄コード & " 処理中]"
    '時系列データ取得
        Call 時系列データ(銘柄コード, "19")
    '銘柄なし(上場廃止)の場合はスキップ
        If Range("A1") <> "日付" Then
            MsgBox "銘柄コード： " & 銘柄コード & "　と一致する銘柄はありません"
            取得フラグ = 1
            GoTo FORNEXT
        End If
    '「時系列データ」更新(毎日19:30頃?)前の場合は「今日の値動き」から当日データを追加
        If Worksheets("Sheet2").Range("A2") <> 計算日 Then
            Call 今日の株価データ(銘柄コード)
        End If
    '出来高なし(売買停止・整理ポスト)の場合はスキップ
        If Worksheets("Sheet2").Range("F2") = "---" Then
            MsgBox "銘柄コード： " & 銘柄コード & "　の出来高がありません"
            取得フラグ = 1
            GoTo FORNEXT
        End If
    '該当銘柄のMM指標計算
        Call 指標計算(i, 指標)
FORNEXT:
    Next
'データ異常の銘柄行削除
    If 取得フラグ = 1 Then
        Range("A3:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Cells(5000, 1).End(xlUp).Select
            rc = ActiveCell.Row       '行末からの最終行取得
    End If
    Application.StatusBar = False    'ステータスバーの制御をExcelに戻す

'シート(Sheet1)編集
    Call 編集1(買売)

'解析結果シ－トの有無チェック
    有無 = 0
    For Each myst In Worksheets
        If myst.Name = ("解析結果") Then
           有無 = 1
           Exit For
        End If
    Next
'結果を解析結果シートへコピー
    If 有無 = 0 Then
        Sheets("Sheet1").Copy Before:=Sheets(1)  '解析結果がないときは新規作成
        Sheets("Sheet1 (2)").Name = "解析結果"
        記録最終行 = rc    '最終行番号保存
    Else
        Sheets("Sheet1").Select
        Range("A3").CurrentRegion.Select
        Selection.Copy
        Range("A1").Select

Sheets("解析結果").Select                '解析結果があるときは続けてコピー
        Application.Cells(記録最終行 + 2, 1).Select
        ActiveSheet.Paste
    End If
    Range("A1").Select
End Sub
Sub 解析2(買売)
    Dim WS As Worksheet
    Dim fdir, fpath, mybk, Style, msgRec As Variant
    Sheets("解析結果").Select
'解析前xlsファイル保存
    Call ファイル出力("xls", 買売)

'サイン点灯銘柄抽出
    If 買売 <> "指定" Then
        Select Case 買売
        Case "買"
            Call 買サイン点灯抽出(買売)
        Case "売"
            Call 売サイン点灯抽出(買売)
        Case Else
            Call 買サイン点灯抽出("買")
            Call 売サイン点灯抽出("売")
        End Select
    End If

'解析後htmlファイル保存
    Call ファイル出力("html", 買売)

'解析結果シート削除
    Sheets("解析結果").Select
    ActiveSheet.Delete
'全シートクリア
    For Each WS In Worksheets
        WS.Cells.Clear
    Next

'終了処理
    Style = vbYesNo + vbExclamation + vbDefaultButton1
    msgRec = MsgBox("「はい」でExcelを終了します" & vbCrLf & _
        "「いいえ」で結果ファイルを開き再解析を行います" _
        , Style, "Excel終了確認")
    mybk = ThisWorkbook.Name          'このブックの名前
    If msgRec = vbYes Then    'Excelを終了
        ThisWorkbook.Saved = True   '保存確認を避けるため、保存済みにする
        If Workbooks.Count <= 1 Then Application.Quit '他にブックが開いていなければExcelを終了する
        ThisWorkbook.Close False    '本ブックをClose
    ElseIf msgRec = vbNo Then '抽出結果ファイルを開く
        fdir = ThisWorkbook.Path          'このマクロの入っているパス
        ChDir fdir
        fpath = fdir & "\mm" & ファイル日付 & ".xls" '解析結果xlsファイルのパス
        Workbooks.Open Filename:=fpath        '解析結果xlsファイルを開く
        CommandBars("worksheet menu bar").Controls("MM法").Delete

Application.ScreenUpdating = True '画面更新表示
        Application.DisplayAlerts = True  '警告メッセージ表示
        Workbooks(mybk).Close False       'MM法.xlsをファイルを保存しないで閉じ終了
    Else
    End If
End Sub
Sub 買サイン点灯抽出(買売)
    Dim rc, i As Variant
    For i = 記録最終行 To 4 Step -1
        If Cells(i, 6) > RSI買 Or Cells(i, 7) < ADX買売 Then
            Rows(i).Select
            Selection.Delete Shift:=xlUp
        End If
    Next
    '抽出後タイトル＆抽出銘柄数
    With Range("A3").CurrentRegion
        rc = .Rows.Count - 2      '抽出件数
    End With
    Cells(2, 1) = "■" & 買売 & "サイン点灯銘柄 （" _
        & 計算日 & " 終値：抽出数 " & rc & "件/ データ " & 買データ数 & "件中）"
End Sub
Sub 売サイン点灯抽出(買売)
    Dim rc, i As Variant
    Range("A1").Select
    Cells(5000, 1).End(xlUp).Select
    記録最終行 = ActiveCell.Row       '行末からの最終行取得
    For i = 記録最終行 To 記録最終行 - 抽出数 Step -1
        If Cells(i, 6) < RSI売 Or Cells(i, 7) < ADX買売 Then
            Rows(i).Select
            Selection.Delete Shift:=xlUp
        End If
    Next
    '抽出後タイトル＆抽出銘柄数
    With Range(Cells(記録最終行 - 抽出数, 1), Cells(記録最終行 - 抽出数, 1)).CurrentRegion
        rc = .Rows.Count - 2      '抽出件数
    End With
    Cells(記録最終行 - 抽出数 - 1, 1) = "■" & 買売 & "サイン点灯銘柄 （" _
        & 計算日 & " 終値：抽出数 " & rc & "件/ データ " & 売データ数 & "件中）"
End Sub
Sub 編集1(買売)
    Dim rc, cc, i, lurl As Variant
    Worksheets("Sheet1").Activate
'最終セル番号取得
    Cells(5000, 1).End(xlUp).Select
        rc = ActiveCell.Row       '行末からの最終行取得
    Cells(3, 100).End(xlToLeft).Select
        cc = ActiveCell.Column    '列末からの最終列取得
'タイトル＆銘柄数
    抽出数 = rc - 3
    If 買売 = "買" Then 買データ数 = 抽出数
    If 買売 = "売" Then 売データ数 = 抽出数
    Cells(2, 1) = "■" & 買売 & "銘柄 （" & 計算日 & " 終値：データ数 " & 抽出数 & "）"
    Cells(2, 1).Font.Bold = True
'銘柄コードリンク生成
    For i = 4 To rc Step 1
        Cells(i, 1).Select
        lurl = YAHOO1 & Cells(i, 1) & YAHOO2
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=lurl
    Next
'見出し行色付け
    Range("A3:D3").Interior.ColorIndex = 39 '薄紫
    Range("E3:G3").Interior.ColorIndex = 40 '薄橙
    Range("H3:J3").Interior.ColorIndex = 34 'シアン
    Range("K3:N3").Interior.ColorIndex = 38 '薄ピンク
'罫線
    Range(Cells(3, 1), Cells(rc, cc)).Select
    Selection.Borders.LineStyle = xlContinuous
'背景色変更(36=薄黄,15=灰色,2=白色)
    For i = 4 To rc Step 1
      '出来高x終値>10億円
        If Cells(i, 3) * Cells(i, 4) >= 1000000000 Then Cells(i, 2).Interior.ColorIndex = 36
      'ボリンジャー
        If Cells(i, 5) = "-3σ" Or Cells(i, 5) = "+3σ" Then Cells(i, 5).Interior.ColorIndex = 36
      'RSI
        If Cells(i, 6) <> "" And (Cells(i, 6) <= 10 Or Cells(i, 6) >= 90) _
        Then Cells(i, 6).Interior.ColorIndex = 36
      'RRR
        If Cells(i, 11) >= 2.5 Then Cells(i, 11).Interior.ColorIndex = 36
      '出来比
        If Cells(i, 12) >= 4 Then Cells(i, 12).Interior.ColorIndex = 15
      '終値比
        If Cells(i, 13) <= -4 Or Cells(i, 13) >= 4 Then Cells(i, 13).Interior.ColorIndex = 15
      '乖離率
        If Cells(i, 14) <= -15 Or Cells(i, 14) >= 15 Then Cells(i, 14).Interior.ColorIndex = 15
    Next
'セル書式
    Columns("C:D").Select
    Selection.NumberFormatLocal = "#,##0_ "   '桁区切り
    Columns("E:E").Select
    Selection.HorizontalAlignment = xlRight   '右寄せ
    Columns("F:I").Select
    Selection.NumberFormatLocal = "0.0_ "     '小数点
    Columns("J:J").Select
    Selection.HorizontalAlignment = xlCenter  '中央揃え
    Columns("K:N").Select
    Selection.NumberFormatLocal = "0.00_ "    '小数点
    Rows("3:3").Select
    Selection.HorizontalAlignment = xlCenter  '中央揃え
    Range("A1").Select
'文字サイズ縮小
    Cells.Select
    With Selection.Font
        .Name = "MS UI Gothic"
        .Size = 9
    End With
'セル幅縮小
    Columns("A:A").Select
    Selection.ColumnWidth = 3.28
    Columns("B:B").Select
    Selection.ColumnWidth = 6.28
    Columns("C:C").Select
    Selection.ColumnWidth = 7.78
    Columns("D:D").Select
    Selection.ColumnWidth = 6.38
    Columns("E:G").Select
    Selection.ColumnWidth = 3.75
    Columns("H:I").Select
    Selection.ColumnWidth = 6.13
    Columns("J:K").Select
    Selection.ColumnWidth = 4.28
    Columns("L:L").Select
    Selection.ColumnWidth = 4.48
    Columns("M:M").Select
    Selection.ColumnWidth = 5.25
    Columns("N:N").Select
    Selection.ColumnWidth = 4.48
End Sub
Sub 銘柄リスト読込(買売)
    Dim nlist(5000, 1) As Variant
    Dim flt$, fname, i As Variant
'ファイル指定
    Worksheets("Sheet3").Activate
    flt$ = "txtファイル(*.txt),*.txt"
    fname = Application.GetOpenFilename(flt$, , Title:=買売 & "銘柄リスト指定")
    If fname = "False" Then
        MsgBox 買売 & "銘柄リスト指定の指定がありません" & vbCrLf & "Excelを終了します"
        ThisWorkbook.Saved = True   '保存確認を避けるため、保存済みにする
        If Workbooks.Count <= 1 Then Application.Quit '他にブックが開いていなければExcelを終了する
        ThisWorkbook.Close False    '本ブックをClose
    Else
    '過去データ削除
        Cells.Select
            Selection.ClearContents
        Range("A1").Select
    'txtデ－タ取り込み
        i = 0
        Open fname For Input As #1
        Do Until EOF(1)
            On Error GoTo REST
            Input #1, nlist(i, 0), nlist(i, 1)
            On Error GoTo 0
            i = i + 1
        Loop
        Close #1

Range(Cells(1, 1), Cells(i + 1, 2)).Value = nlist
        Application.StatusBar = 買売 & "銘柄リスト " & i - 3 & "件 取り込みました"
        Exit Sub
REST:
        Close #1
        MsgBox fname & "ファイルのデータ取得に失敗しました。"
        On Error GoTo 0
    End If
End Sub
Sub ファイル出力(拡張子, 買売)
    Dim fdir, fpath, mybk, wkbk, myst, X As Variant
    fdir = ThisWorkbook.Path            'このマクロの入っているパス
    mybk = ThisWorkbook.Name            'このブックの名前

Workbooks.Add                       '作業用ブック追加
    wkbk = ActiveWorkbook.Name          '作業用ブック名
    Windows(mybk).Activate
        Cells.Select
        Selection.Copy                  '取得データをコピー
    Windows(wkbk).Activate
        Range("A1").Select
        ActiveSheet.Paste               '作業用ブックへ貼付け
    Range("A1").Select

'Sheet1名を当日日付に変更
    Worksheets("Sheet1").Activate
    Sheets("Sheet1").Name = ファイル日付
    myst = ActiveSheet.Name
'Sheet2,Sheet3削除
    X = Array("Sheet2", "Sheet3")
    Windows(wkbk).Activate
    Worksheets(X).Delete

'銘柄指定の場合は計算過程データ(Sheet2,Sheet3)も保存する
    If 買売 = "指定" Then
        Windows(mybk).Activate
        Worksheets(X).Copy After:=Workbooks(wkbk).Sheets(myst)
    End If

'ファイル保存
    If 拡張子 = "xls" Then
        fpath = fdir & "\mm" & ファイル日付 & "." & 拡張子 'xls保存先ファイル
        ActiveWorkbook.SaveAs Filename:=fpath, FileFormat:=xlNormal
        MsgBox fdir & " へ mm" & ファイル日付 & "." & 拡張子 & " を保存しました。"
        '買売一括抽出、銘柄リスト解析の場合は月間ファイルへコピー
        If 買売 = "" Or 買売 = "外部" Then
            Call 月間ファイル(買売)
        End If
    ElseIf 拡張子 = "html" Then
        fpath = fdir & "\mm" & ファイル日付 & "." & 拡張子 'html保存先ファイル
        With ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
            fpath, myst, "", xlHtmlStatic, "Book1_23303", "")
            .Publish (True)
            .AutoRepublish = False
        End With
        MsgBox fdir & " へ mm" & ファイル日付 & "." & 拡張子 & " を保存しました。"
    ElseIf 拡張子 = "txt" Then
        fpath = fdir & "\mm" & ファイル日付 & 買売 & "." & 拡張子 'csv保存先ファイル
        ActiveWorkbook.SaveAs Filename:=fpath, FileFormat:=xlCSV 'csv形式で保存
        MsgBox fdir & " へ mm" & ファイル日付 & 買売 & "." & 拡張子 & " を保存しました。"
    Else
    End If
'作業用ブックを閉じる
    ActiveWorkbook.Close
End Sub
Sub 月間ファイル(買売)
    Dim fdir, fpath, myst, 元name, 先name, 有無 As Variant
    fdir = ThisWorkbook.Path            'このマクロの入っているパス
    元name = "mm" & ファイル日付 & ".xls"
    先name = "mm" & Left(ファイル日付, 6) & ".xls"
    fpath = fdir & "\" & 先name
'保存先xlsファイルオープン
    On Error GoTo GENFILE
    'フォルダに指定したファイルがあるときファイルを展開する
    Workbooks.Open Filename:=fpath, UpdateLinks:=0
    GoTo OWARI
GENFILE:
    'フォルダに指定したファイルがないときファイルを新規作成して名前を付ける
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=fpath
OWARI:
'シ－トの有無チェック
    有無 = 0
    For Each myst In Worksheets
        If myst.Name = ファイル日付 Then
           有無 = 1
           Exit For
        End If
    Next
'月間ファイルへコピー
    Windows(元name).Activate
    Sheets(ファイル日付).Select
    If 有無 = 1 Then    'シート有りの時はシート削除
        Workbooks(先name).Sheets(ファイル日付).Delete
    End If
    Sheets(ファイル日付).Copy Before:=Workbooks(先name).Sheets(1)
    MsgBox fdir & " の " & 先name & " に " & 元name & " を追加しました。"
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub
Sub カブーデータ(買売)
    Dim rc, i, wurl As Variant
    wurl = KABOO & 買売    'カブーデータ取得先URL
'過去データ("Sheet3")削除
    Worksheets("Sheet3").Activate
    Cells.Select
    Selection.ClearContents
    Range("A1").Select

'カブーデータ取得
    With ActiveSheet.QueryTables.Add(Connection:=wurl, _
         Destination:=Cells(1, 1))

.RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = False
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .Refresh BackgroundQuery:=False
    End With
'日付保存用の行挿入
'    Range("A2").EntireRow.Insert
'東証指数などコードのない銘柄処理
    Cells(5000, 1).End(xlUp).Select
        rc = ActiveCell.Row       '行末からの最終行取得
    For i = rc To 4 Step -1
        If Cells(i, 1) <= 1300 Then  '銘柄コード1300以下は削除
            Rows(i).Select
            Selection.Delete Shift:=xlUp
        End If
    Next
End Sub
Sub 日付作成(買売)
    Dim ymd, d11y, d11m, d11d As Variant
    Dim strs, stre As Variant
    Worksheets("Sheet3").Activate
    ymd = Cells(1, 1).Value
    strs = InStr(1, ymd, "（", 1) + 1      '"("の文字位置+1
    stre = InStr(1, ymd, ")", 1)           '")"の文字位置
    ymd = Mid(ymd, strs, stre - strs)      '日付抽出
    d11y = Year(ymd) - 12                  '平成を西暦に変換
    d11m = Month(ymd)
    d11d = Day(ymd)
    計算日 = DateSerial(d11y, d11m, d11d)     '計算対象日
    ファイル日付 = Replace(計算日, "/", "")   'ファイル名用
    Cells(2, 1) = ファイル日付
End Sub
Sub 時系列データ(銘柄コード, 取得位置)
    Dim rc, i As Variant
'過去データ("Sheet2")削除
    Worksheets("Sheet2").Activate
    Cells.Select
    Selection.ClearContents
    Range("A1").Select

'取得準備1
    取得終了日 = 計算日
    取得開始日 = 取得終了日 - 70    '最終取得日より70日前（休日も含むこよみ暦日数）
    取得最終行 = 1
'データ取得1
    Call 時系列取得(銘柄コード, 取得位置)
'取得準備2                 取得1以前の70日をダウンロード
    取得終了日 = 取得開始日 - 1
    取得開始日 = 取得終了日 - 70
    Cells(5000, 1).End(xlUp).Select
    取得最終行 = ActiveCell.Row + 1    '取得1で貼り付けた次の行から貼り付ける
'データ取得2
    Call 時系列取得(銘柄コード, 取得位置)

'株データ以外の行削除
    Range("A1").Select
    Cells(5000, 1).End(xlUp).Select
        rc = ActiveCell.Row
    For i = rc To 2 Step -1
      If IsNumeric(Cells(i, 2)) = False Or Cells(i, 2) = "" Then
          Rows(i).Select
          Selection.Delete Shift:=xlUp
      End If
    Next
    Range("A1").Select
End Sub
Sub 時系列取得(銘柄コード, 取得位置)
    Dim wurl, d10y, d10m, d10d, d11y, d11m, d11d As Variant
'スタート日
    d10y = Year(取得開始日)
    d10m = Month(取得開始日)
    d10d = Day(取得開始日)
'最終取得日
    d11y = Year(取得終了日)
    d11m = Month(取得終了日)
    d11d = Day(取得終了日)

'URLと日付指定
    wurl = YAHOO & "t?c=" & d10y & "&a=" & d10m & "&b=" & d10d & "&f=" & d11y & "&d=" _
        & d11m & "&e=" & d11d & "&g=d&s=" & 銘柄コード & "&y=0&z="
'データ取得
    With ActiveSheet.QueryTables.Add(Connection:=wurl, _
         Destination:=Cells(取得最終行, 1))
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = False
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = 取得位置
        .Refresh BackgroundQuery:=False
    End With
End Sub
Sub 今日の株価データ(銘柄コード)
    Dim i As Variant
    Worksheets("Sheet3").Activate
'過去データ削除
    Columns("M:W").Select
    Selection.Delete Shift:=xlToLeft
    Call 今日株価取得(銘柄コード, "13")
'取得失敗(広告表示の有無による)の時は取得位置を変更してリトライを繰り返す
    For i = 1 To 10
        If IsNumeric(Cells(2, 16)) = False Or Cells(2, 16) = "" Then
            Call 今日株価取得(銘柄コード, "12")
        Else
            Exit For
        End If
        If IsNumeric(Cells(2, 16)) = False Or Cells(2, 16) = "" Then
            Call 今日株価取得(銘柄コード, "13")
        Else
            Exit For
        End If
    Next
'20回リトライしても取得できないときはメッセージ表示後Excel終了
    If i = 10 And (IsNumeric(Cells(2, 16)) = False Or Cells(2, 16) = "") Then
        MsgBox "Yahooファイナンス今日の株価データが取得できませんでした" & vbCrLf & _
            "銘柄コード： " & 銘柄コード & "　　銘柄： " & Worksheets("Sheet3").Cells(i, 2)
        Application.StatusBar = False
        End    'マクロを終了
    End If
'今日の株価データをSheet2の先頭に追加
    Worksheets("Sheet2").Activate
    Range("A2").EntireRow.Insert '1行の挿入
    Range("A2") = 計算日                             '日付
    Range("B2") = Worksheets("Sheet3").Cells(2, 20)  '始値
    Range("C2") = Worksheets("Sheet3").Cells(2, 21)  '高値
    Range("D2") = Worksheets("Sheet3").Cells(2, 22)  '安値
    Range("E2") = Worksheets("Sheet3").Cells(2, 16)  '終値
    Range("F2") = Worksheets("Sheet3").Cells(2, 19)  '出来高
End Sub
Sub 今日株価取得(銘柄コード, 取得位置)
    Dim wurl As Variant
    Worksheets("Sheet3").Activate
    wurl = "URL;" & YAHOO1 & 銘柄コード & "&d=v2"
'データ取得(Sheet3Cells(1, 13)に一時保存)
    With ActiveSheet.QueryTables.Add(Connection:=wurl, _
         Destination:=Cells(1, 13))
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = False
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = 取得位置
        .Refresh BackgroundQuery:=False
    End With
End Sub
Sub 指標計算(行番号, 指標)
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 1) = Worksheets("Sheet3").Cells(行番号, 1)  '銘柄コード
    Cells(行番号, 2) = Worksheets("Sheet3").Cells(行番号, 2)  '銘柄名
    Cells(行番号, 3) = Worksheets("Sheet2").Range("F2")       '出来高(Yahoo)
    Cells(行番号, 4) = Worksheets("Sheet2").Range("E2")       '終値(Yahoo)
    Application.ScreenUpdating = False  '画面更新非表示

Select Case 指標
    Case "ボリンジャー"
        Call ボリンジャー(行番号)
    Case "RSI"
        Call RSI(行番号)
    Case "ADX"
        Call ADX(行番号)
    Case "MACD"
        Call MACD(行番号)
    Case "RRR"
        Call RRR(行番号)
    Case "出来比"
        Call 出来比(行番号)
    Case "終値比"
        Call 終値比(行番号)
    Case "乖離率"
        Call 乖離率(行番号)
    Case Else
        Call 出来比(行番号)        '出来高が必要のため一番最初に計算
        Call ボリンジャー(行番号)
        Call RSI(行番号)
        Call ADX(行番号)
        Call MACD(行番号)
        Call RRR(行番号)
        Call 終値比(行番号)
        Call 乖離率(行番号)
    End Select
End Sub
Sub ボリンジャー(行番号)
    Worksheets("Sheet2").Activate
        Columns("F:N").Select    '出来高＆調整後終値*行削除
        Selection.Delete Shift:=xlLeft
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-1]:R[19]C[-1])"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+2*STDEVP(RC[-2]:R[19]C[-2])"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]-2*STDEVP(RC[-3]:R[19]C[-3])"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]+3*STDEVP(RC[-4]:R[19]C[-4])"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=RC[-4]-3*STDEVP(RC[-5]:R[19]C[-5])"
'判定
    If Range("E2") < Range("F2") Then Range("K2") = "-2σ" Else Range("K2") = "+2σ"
    If Range("E2") < Range("J2") Then Range("K2") = "-3σ"
    If Range("E2") > Range("I2") Then Range("K2") = "+3σ"
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 5) = Worksheets("Sheet2").Range("K2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub
Sub RSI(行番号)
    Worksheets("Sheet2").Activate
        Columns("F:N").Select    '出来高＆調整後終値*行削除
        Selection.Delete Shift:=xlLeft
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=+R[1]C[-1]-RC[-1]"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F14"), Type:=xlFillDefault
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIF(RC[-1]:R[12]C[-1],"">0"",RC[-1]:R[12]C[-1])/13"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=ABS(SUMIF(RC[-2]:R[12]C[-2],""<0"",RC[-2]:R[12]C[-2])/13)"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=100-RC[-2]/(RC[-2]+RC[-1])*100"
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 6) = Worksheets("Sheet2").Range("I2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub
Sub ADX(行番号)
    Worksheets("Sheet2").Activate
        Columns("F:N").Select    '出来高＆調整後終値*行削除
        Selection.Delete Shift:=xlLeft
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]>R[1]C[-3],RC[-3]-R[1]C[-3],0)"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F31"), Type:=xlFillDefault
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=IF(R[1]C[-3]>RC[-3],R[1]C[-3]-RC[-3],0)"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G31"), Type:=xlFillDefault
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]>RC[-1],RC[-2],0)"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H31"), Type:=xlFillDefault
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]<RC[-2],RC[-2],0)"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I31"), Type:=xlFillDefault
    Range("J2").Select
    ActiveCell.FormulaR1C1 = _
        "=MAX((RC[-7]-RC[-6]),(RC[-7]-R[1]C[-5]),(R[1]C[-5]-RC[-6]))"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J31"), Type:=xlFillDefault
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-3]:R[13]C[-3])"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K18"), Type:=xlFillDefault
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-3]:R[13]C[-3])"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L18"), Type:=xlFillDefault
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-3]:R[13]C[-3])"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M18"), Type:=xlFillDefault
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]/RC[-1]*100"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N18"), Type:=xlFillDefault
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]/RC[-2]*100"
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O18"), Type:=xlFillDefault
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=ABS(RC[-2]-RC[-1])/(RC[-2]+RC[-1])*100"
    Range("P2").Select
    Selection.AutoFill Destination:=Range("P2:P18"), Type:=xlFillDefault
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-1]:R[8]C[-1])"
    Range("Q2").Select
    Selection.AutoFill Destination:=Range("Q2:Q10"), Type:=xlFillDefault
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=(RC[-1]+R[8]C[-1])/2"
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 7) = Worksheets("Sheet2").Range("P2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub
Sub MACD(行番号)
    Dim rc As Variant
    Worksheets("Sheet2").Activate
        Columns("F:N").Select    '出来高＆調整後終値*行削除
        Selection.Delete Shift:=xlLeft
    Range("A1").Select
    Cells(5000, 1).End(xlUp).Select
        rc = ActiveCell.Row    '最終行
    If rc > 20 Then
        Cells(rc - 4, 6).Formula = "=AVERAGE(R[4]C[-1]:RC[-1])"
        Range(Cells(2, 6), Cells(rc - 5, 6)).Formula = "=+R[1]C+((RC[-1]-R[1]C)*2/(1+5))"
        Cells(rc - 19, 7).Formula = "=AVERAGE(R[19]C[-2]:RC[-2])"
        Range(Cells(2, 7), Cells(rc - 20, 7)).Formula = "=+R[1]C+((RC[-2]-R[1]C)*2/(1+20))"
        Range("H2").Select
        ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
        Range("H2").Select
        Selection.AutoFill Destination:=Range("H2:H11"), Type:=xlFillDefault
        Range("I2").Select
        ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-1]:R[8]C[-1])"
        Range("I2").Select
        Selection.AutoFill Destination:=Range("I2:I3"), Type:=xlFillDefault
        Range("J2").Select
        ActiveCell.FormulaR1C1 = "=+RC[-2]-RC[-1]"
        Range("J2").Select
        Selection.AutoFill Destination:=Range("J2:J3"), Type:=xlFillDefault
        Range("K2").Select
        ActiveCell.FormulaR1C1 = "=AND(R[1]C[-3]<R[1]C[-2],RC[-3]>RC[-2])"
        Range("L2").Select
        ActiveCell.FormulaR1C1 = "=AND(R[1]C[-4]>R[1]C[-3],RC[-4]<RC[-3])"
'クロス判定
        Range("M2") = "－"
        If Range("K2") = True Then Range("M2") = "Golden"
        If Range("L2") = True Then Range("M2") = "Dead"
    Else  'データ数不足の場合は**
        Range("H2") = "**"
        Range("I2") = "**"
        Range("M2") = "**"
    End If
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 8) = Worksheets("Sheet2").Range("H2")
    Cells(行番号, 9) = Worksheets("Sheet2").Range("I2")
    Cells(行番号, 10) = Worksheets("Sheet2").Range("M2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub
Sub RRR(行番号)
    Call ボリンジャー(行番号)
    Worksheets("Sheet2").Activate
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=ABS(RC[-6]-RC[-5])/(RC[-7]*5%)"
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 11) = Worksheets("Sheet2").Range("L2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub
Sub 出来比(行番号)
    Worksheets("Sheet2").Activate
        Columns("G:N").Select    '調整後終値*行削除
        Selection.Delete Shift:=xlLeft
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C[-1]:R[5]C[-1])"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]"
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 12) = Worksheets("Sheet2").Range("H2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub
Sub 終値比(行番号)
    Worksheets("Sheet2").Activate
        Columns("F:N").Select    '出来高＆調整後終値*行削除
        Selection.Delete Shift:=xlLeft
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=(RC[-1]-R[1]C[-1])/RC[-1]*100"
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 13) = Worksheets("Sheet2").Range("F2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub
Sub 乖離率(行番号)
    Worksheets("Sheet2").Activate
        Columns("F:N").Select    '出来高＆調整後終値*行削除
        Selection.Delete Shift:=xlLeft
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGEA(RC[-1]:R[24]C[-1])"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-1])/RC[-1]*100"
    Range("A1").Select
'コピー
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = True   '画面更新表示
    Cells(行番号, 14) = Worksheets("Sheet2").Range("G2")
    Application.ScreenUpdating = False  '画面更新非表示
End Sub

ThisWorkbook　ソース選択
Option Explicit Private Sub Workbook_Open() Dim menu1 As CommandBar Dim menu2 As CommandBarControl Set menu1 = Application.CommandBars("worksheet menu bar") Set menu2 = menu1.Controls.Add(Type:=msoControlPopup, Temporary:=True) menu2.Caption = "MM法" With menu2 .Controls.Add Type:=msoControlButton With .Controls(1) .Caption = "買売一括抽出" .OnAction = "買売一括抽出" .FaceId = 532 End With .Controls.Add Type:=msoControlButton With .Controls(2) .Caption = " 　買銘柄抽出" .OnAction = "買銘柄抽出" End With .Controls.Add Type:=msoControlButton With .Controls(3) .Caption = " 　売銘柄抽出" .OnAction = "売銘柄抽出" End With .Controls.Add Type:=msoControlButton With .Controls(4) .BeginGroup = True '区切り縦線 .Caption = "指定銘柄解析" .OnAction = "指定銘柄解析" .FaceId = 302 End With .Controls.Add Type:=msoControlButton With .Controls(5) .BeginGroup = True '区切り縦線 .Caption = "銘柄リスト解析" .OnAction = "銘柄リスト解析" .FaceId = 989 End With .Controls.Add Type:=msoControlButton With .Controls(6) .Caption = " 　銘柄リスト保存" .OnAction = "銘柄リスト保存" End With .Controls.Add Type:=msoControlButton With .Controls(7) .BeginGroup = True '区切り縦線 .Caption = "抽出条件変更" .OnAction = "抽出条件変更" .FaceId = 526 End With .Controls.Add Type:=msoControlButton With .Controls(8) .BeginGroup = True '区切り縦線 .Caption = "投資の杜Webページ" .OnAction = "投資の杜Webページ" .FaceId = 1576 End With End With '抽出判定既定値設定 RSI買 = 25 'RSI買判定値 RSI売 = 75 'RSI売判定値 ADX買売 = 75 'ADX判定値 End Sub
ThisWorkbook

UserForm1　ソース選択
Option Explicit Private Sub CommandButton1_Click() Application.CutCopyMode = False 'コピーモードを解除する Call 銘柄指定 Call 指標選択 Unload Me 'ユーザーフォームを消す End Sub Private Sub 銘柄指定() 銘柄コード = Me.TextBox1.Text If 銘柄コード = "" Or Len(銘柄コード) <> 4 Then MsgBox "取得する銘柄コード(数字4桁)を入力して下さい" Exit Sub End If End Sub Private Sub 指標選択() If Me.OptionButton1.Value = True Then 指標 = "ボリンジャー" ElseIf Me.OptionButton2.Value = True Then 指標 = "RSI" ElseIf Me.OptionButton3.Value = True Then 指標 = "ADX" ElseIf Me.OptionButton4.Value = True Then 指標 = "MACD" ElseIf Me.OptionButton5.Value = True Then 指標 = "RRR" ElseIf Me.OptionButton6.Value = True Then 指標 = "出来比" ElseIf Me.OptionButton7.Value = True Then 指標 = "終値比" ElseIf Me.OptionButton8.Value = True Then 指標 = "乖離率" ElseIf Me.OptionButton9.Value = True Then 指標 = "全指標" Else 指標 = "" End If End Sub Private Sub CommandButton2_Click() 銘柄コード = "" 指標 = "" Unload Me 'ユーザーフォームを消す End Sub Private Sub UserForm_Initialize() Me.OptionButton9.Value = True Me.TextBox1.SetFocus 'テキストボックスにフォーカスを合わす End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode <> vbFormCode Then 'マクロから閉じられたのではないなら Cancel = True '閉じる[×]ボタンを無効にする End If End Sub

UserForm2　ソース選択
Option Explicit Private Sub CommandButton1_Click() Application.CutCopyMode = False 'コピーモードを解除する RSI買 = Me.TextBox1.Text RSI売 = Me.TextBox2.Text ADX買売 = Me.TextBox3.Text Unload Me 'ユーザーフォームを消す End Sub Private Sub CommandButton2_Click() Unload Me 'ユーザーフォームを消す End Sub Private Sub UserForm_Initialize() Me.TextBox1.Text = RSI買 Me.TextBox2.Text = RSI売 Me.TextBox3.Text = ADX買売 End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode <> vbFormCode Then 'マクロから閉じられたのではないなら Cancel = True '閉じる[×]ボタンを無効にする End If End Sub
UserForm1 UserForm2