銘柄リスト取込

2-4.銘柄リスト取込(txtファイルから取得例)

(1)　概略
掲示板に
KIkabe(load_np)の銘柄コードを入れるところをInputBoxではなく、他のリストから持ってくるというマクロを教えていただきたいのですが・・・。
と言う依頼があり本ページを作成。

内容としては、KIkabe(load_np)のテキストボックスの代わり下図のユーザーフォームにした例です。

なお、銘柄リストは下図のようなtxtファイルを使用であり自作すること。

(2)KIkabu(load_np)の変更箇所
今回紹介のユーザーフォームを使用する場合、KIkabu(load_np)は以下のように 1部変更してください。


Sub load_np()

'画像削除
    ActiveSheet.Unprotect
    For Each zu In ActiveSheet.Shapes
        zu.Delete
    Next
'過去データ削除
 Cells.Select
    Selection.ClearContents
    Range("A1").Select
    
 Call 銘柄表取込
    
'銘柄コード指定
    UserForm1.Show vbModeless
End Sub
'-------------------------------------------------------------------------------
Sub load実行()
    meino = UserForm1.txt1.Text
    If Len(meino) <> 4 Then
        MsgBox "取得する銘柄コードを数字4桁で入力して下さい"
        Exit Sub
    End If
    UserForm1.Hide

　　・・・・・・・・・・・以下は同じ

[1]　UserForm1.Show vbModeless でモードレス指定の関係でExcel2000以降が対象
[2]　メインのオブジェクトは「load実行」にしてユーザーフォームから呼び出しに変更

(3)ユーザーフォームモジュール
ユーザーフォームのプロパティに付けた名称は下図参照のこと。


Private Sub cmb1_Click()
    Call load実行
End Sub
'-------------------------------------
Private Sub cmb21_Click()
    Call 次へ
End Sub
'-------------------------------------
Private Sub cmb22_Click()
    Call 戻る
End Sub
'-------------------------------------
Private Sub cmb3_Click()
    Call ファイル指定
End Sub
'-------------------------------------
Private Sub cmb4_Click()
    UserForm1.Hide
End Sub

(4)txtデ－タ取り込み
このプロシージャでtxtファイルをファイルを開かずに配列へ読み込みます。


Dim dat(5000, 1) As String    '銘柄リスト
Dim txtname As String         'txtファイル名
Dim listno As Integer         'リスト番号

Sub 銘柄表取込()
'記録されているtxtファイル
    fff = ThisWorkbook.Worksheets("Sheet3").Cells(1, 1)　　　　		'[1]
    
'ファイル指定前ガード
If fff = "" Then
   Exit Sub
End If
   
dai = Dir(fff)								'[2]
If dai = "" Then
   MsgBox fff & "ファイルが見つかりません。" & Chr$(10) & Chr$(10) _
    & "パス・ファイル名が異なる場合は「ファイル指定」で変更して下さい"
    Exit Sub
End If

'2重取込ガード
If dat(0, 0) <> "" Then
    Exit Sub
End If

'txtデ－タ取り込み							'[3]
    i = 1
    Open fff For Input As #1
Do Until EOF(1)
    On Error GoTo rest							'[4]
    Input #1, dat(i, 0), dat(i, 1)
    On Error GoTo 0
     i = i + 1
Loop
Close #1

dat(0, 0) = i - 1							'[5]
UserForm1.lbl1.Caption = fff & "取込完了"
UserForm1.txt1.Text = dat(0, 1)
Exit Sub
rest:
   Close #1
   MsgBox fff & "ファイルのデータ取得に失敗しました。" & Chr$(10) _
    & "txtファイルのデータの最終以降に空白等入っていないか確認して下さい" & Chr$(10) _
   & "もし空白がある場合はデータの最後を選択しDeleteキーを数回押し訂正してください。"
   On Error GoTo 0
    End
End Sub

[1]同じtxtファイルの使用を考慮し"Sheet3"のA1セルにある、前回のパスとファイル名を読み取る
[2]指定のtxtファイルがあるか確認
[3]txtデ－タ取り込み。バッファーを開きダイレクトに読む場合は必ず Close すること。
[4]txtファイルのフォーマットが異なる場合のエラー対策
[5]本例の場合、データ数をdat(0, 0)に入れ後で使用している

(5)txtファイル指定
自作のtxtファイルの保存場所を指定。（下図参照）
指定したファイルは再使用を考慮しシート"Sheet3"のA1セルへ保存（シート名Sheet3がある前提）


Sub ファイル指定()
    
 flt$ = "txtファイル(*.txt),*.txt"
txtname = Application.GetOpenFilename(flt$, , Title:="txtファイル指定")

If txtname <> "False" Then
    ThisWorkbook.Worksheets("Sheet3").Cells(1, 1) = txtname
Else
    MsgBox "ファイルの指定がありません"
    Exit Sub
End If
   dat(0, 0) = ""     '前データ消す
   Call 銘柄表取込
End Sub

(6)配列データを1個進める


Sub 次へ()
If listno = 0 Then
    listno = 1
Else
    listno = listno + 1
    If listno > dat(0, 0) Then 				'[1]
        listno = dat(0, 0)
        MsgBox "これ以上データがありません"
    End If
End If

With UserForm1
    .txt1.Text = dat(listno, 0)
    .lbl1.Caption = " " & listno & "." & dat(listno, 1) & "[" & dat(listno, 0) & "]"
End With

End Sub

[1] データの最後をチェック

(7)配列データを1個戻す


Sub 戻る()
listno = listno - 1
    If listno < 1 Then                    		'[1]
        listno = 1
        MsgBox "これ以下のデータがありません"
    End If

With UserForm1
    .txt1.Text = dat(listno, 0)
    .lbl1.Caption = listno & ".[" & dat(listno, 0) & "]" & dat(listno, 1)
End With

End Sub

[1] データの配列番号が1以下にならないようにチェック

【戻る】