VBAでtxtを検索

Question

質問失礼いたします
プログラミングの経験がなく、VBA自体を初めて触るものです
VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業ですが、excelワークシートに入力する場所を３０枠用意し、間に空白のセルがあってもちゃんと検索し、出力できるようにしたいです

わからないなりに書き換えてみましたが、Public Sub executeSeachAndOutput(ByVal inputDataList As Variant)
の部分で処理が止まってしまいます
どのようにすればいいか、どこを改修すればいいのかヒントでもいいので教えていただきたいです

また、こうした処理をする場合、テキストボックスを使用するのとセルに入力してもらうのとどちらの形の方が作りやすいですか?

'標準モジュール

'ファイル取得処理
Public Sub GET_TextFile()
    Dim objFS     As Object
    Dim strPath         As String
    Dim strFile         As String
    Dim strFolder       As String
    Dim ofdFolderDlg    As Office.FileDialog

    strPath = Range("selectFileName").Value
    Set objFS = CreateObject("Scripting.FileSystemObject")

    ' 初期パスの設定
    If Len(strPath) > 0 Then
        ' 末尾の"\"削除
        If Right(strPath, 1) = "\" Then
            strPath = Left(strPath, Len(strPath) - 1)
        End If

        ' ファイルが存在
        If objFS.FileExists(strPath) Then
            ' ファイル名のみ取得
            strFile = objFS.GetFileName(strPath)
            ' フォルダパスのみ取得
            strFolder = objFS.GetParentFolderName(strPath)
        ' ファイルが存在しない
        Else
            ' フォルダが存在
            If objFS.FolderExists(strPath) Then
                strFile = ""
                strFolder = strPath
            ' フォルダが存在しない
            Else
                ' ファイル名のみ取得
                strFile = objFS.GetFileName(strPath)
                ' 親フォルダを取得
                strFolder = objFS.GetParentFolderName(strPath)
                ' 親フォルダが存在しない
                If Not objFS.FolderExists(strFolder) Then
                    strFolder = ThisWorkbook.Path
                End If
            End If
        End If
        Set objFS = Nothing
    Else
        strFolder = ThisWorkbook.Path
        strFile = ""
    End If

    ' ファイル選択ダイアログ設定
    Set ofdFileDlg = Application.FileDialog(msoFileDialogFilePicker)
    With ofdFileDlg
        .ButtonName = "選択"
        '「ファイルの種類」をクリア
        .Filters.Clear
        '「ファイルの種類」を登録
        .Filters.Add "テキストファイル", "*.txt", 1
        .Filters.Add "全ファイル", "*.*", 2

        ' 初期フォルダ
        .InitialFileName = strFolder & "\" & strFile
        ' 複数選択不可
        .AllowMultiSelect = False
        '表示するアイコンの大きさを指定
        .InitialView = msoFileDialogViewDetails
    End With
    
    
    
    ' フォルダ選択ダイアログ表示
    If ofdFileDlg.Show() = -1 Then
        ' フォルダパス設定
        strPath = ofdFileDlg.SelectedItems(1)
    Else
        ' キャンセルされた場合以降の処理は行なわない
        Exit Sub
    End If

    Range("selectFileName").Value = strPath
    Dim all As New Collection
    Set all = New Collection
    Set all = READ_TextFile(strPath)
    
    '検索出力実行
    Dim main As New suzukiMain
    Call main.executeSeachAndOutput(all)
    Set ofdFileDlg = Nothing
    
    MsgBox "CSVファイルを" & Chr(13) & strPath & Chr(13) & "に出力完了しました。"
    
End Sub
' ファイルの読み込み処理
'配列に格納する処理
Private Function READ_TextFile(ByVal strPathName As String) As Collection
    Dim intNo As Integer
    Dim objFS As Object
    Dim strBuff As String
    strPath = strPathName
    
    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    If objFS.FileExists(strPath) = False Then
       Exit Function
    End If

    ' ファイルオープン
    intNo = FreeFile()                      ' フリーファイルNoを取得
    Open strPathName For Input As #intNo    ' ファイルをオープン
    
    ' ファイルの読み込み
    Dim arrayList As New Collection
    Set arrayList = New Collection
    Dim readList As New Collection
    Set readList = New Collection
    
    Do Until EOF(intNo)                     ' ファイルの最後までループ
                
        Line Input #intNo, strBuff          ' ファイルから一行読み込み
        
        
        If Left(strBuff, 1) <> 2 Then '区分コードが2以外の場合次の行へ
          GoTo nextLine
        End If
        
        readList.Add Trim(Mid(strBuff, 51, 30))      '氏名
        readList.Add Trim(Mid(strBuff, 6, 15))       '銀行名
        readList.Add Trim(Mid(strBuff, 24, 19))      '支店名
        readList.Add Trim(Mid(strBuff, 2, 4))        '銀行コード
        readList.Add Trim(Mid(strBuff, 21, 3))      '支店コード
        readList.Add Trim(Mid(strBuff, 43, 8))     '口座番号
        readList.Add Trim(Mid(strBuff, 43, 1))      '口座種類
        arrayList.Add readList                '読み込んだ値をリストに格納
        Set readList = New Collection 'リスト初期化
   
nextLine:

    Loop
    
    ' ファイルクローズ
    Close #intNo
    
    '戻り値設定
    Set READ_TextFile = arrayList
   
End Function






'ここからクラスモジュール




'クラスモジュールcommon
Public Function getMaxRow(ByVal sheetName As String, ByVal cal As Long) As Long
'最大行取得
Dim maxRow As Long

'下から
maxRow = ThisWorkbook.Sheets(sheetName).Cells(Rows.count, cal).End(xlUp).row

'結果を返却
getMaxRow = maxRow

End Function

Public Function getDataList(ByVal sheetName As String, ByVal startRow As Long, ByVal cal As Long) As Collection
'データリスト取得
Dim resultList As Collection
Set resultList = New Collection

'最大行取得
Dim maxRow As Long
maxRow = getMaxRow(sheetName, cal)

'最大行まで取得
Dim takeData As String
Dim count As Long
For count = startRow To maxRow
    takeData = ThisWorkbook.Sheets(sheetName).Cells(count, cal).Value
    resultList.Add takeData
Next count

'結果を返却
Set getDataList = resultList

End Function







'クラスモジュールsearchName

Public Function executeSeach(ByVal inputDataList As Variant, ByVal nameList As Variant) As Variant

Dim hitDataList(29) As Variant

Dim inputItemList(29) As Variant

Dim inputNameData(29) As Variant
Dim nameItem(29) As Variant
Dim nameData(29) As Variant


For Each inputItemList In Range("B12:B41")
  nameData = inputItemList.Item


For Each nameItem In nameList
        If InStr(nameData, nameItem) <> 0 Then
            hitDataList.Add inputItemList
        End If
    Next nameItem
    
End Function

以上について回答宜しくお願いします
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞

Comments

[aki.aki.]

失礼ながら、質問と言うよりは、改修依頼になっていますね。
（でも、私は時間さえあれば、クイズ感覚で答えるのは好きなのですが。）
やはり、ここは周囲に聞くなり、ご自分で調べることから始めた方がいいかと思います。辛口、失礼。

[ttyp03]

やりたいことが２つあって、それぞれで何がわからなくてつまづいているのか書きましょう。
あと、
＞これがその処理をしていると思われるクラスモジュールです
「処理をしていると思われる」程度の情報をあげられても困ります。
違うところだったらまったくの時間の無駄です。
それくらいは確定した情報の提供をお願いします。

Answer 1

提示のコードは、クラスモジュールではない、ただの関数、その関数の内容を理解しているのか、できているのか、ちょっと疑問。
関数としては、データをCollectionに格納して比較しているが、今回の要件ではCollectionでは使いづらいので、これは無視して一から作成したほうがいいでしょう。

方針として下記ようになるでしょう。

（１）txtファイルを読み込む
1行ずつ読み込むか、一気に読み込んでSplitで行枚の配列にするか、のどちらかになります。
「vba txtファイル 読み込み」等をキーワードにWEB検索すればサンプルコードはたくさん見つかるでしょう。
（２）入力枠とは、ユーザーフォームにテキストボックスを配置することを想定していますか。それとも、シートのセルに入力させますか。その辺の仕様も明確に決めましょう。

他にも、ご提示のことをするには、いろいろな処理が必要ですが、とりあえず、txtファイルを読み込んで、配列にする、ことから始めてはどうでしょうか。

そこで、分からないことが出たり、行き詰ったら、その時点で、ワンポイントで質問しましょう。

Comments

[yuurin]

対応ありがとうございます
入力枠の仕組みとしては、シートのセルに直接入力する仕組みになっています

[hatena19]

質問文は編集できるので、コードは質問文の方に追加してください。
あと、コードを提示して「はい、改修してください」ではなく、
どの部分が想定通りにいかないのか、ピンポイントで質問してください。

[hatena19]

提示のコードは不足しているので、動作しません。コードを提示して「改修してください」ではなく、問題点を切り分けて一つずつご自身で解決するように努力してください。提示のコードでおそらくcsvの読み込みはできているようですので、それと入力枠のデータとの比較するコードをまずはご自身で書いてください。それでうまくいかない部分を質問してください。

Answer 2

なが～いコードが書いてあるけど、
VB流のコードかな？
折角、エクセル君を使うのだから、エクセル君が出来ることは、エクセル君に任せた方が、
処理速度が速いし、開発も楽です。
（速度的に言ったら処理によっては別の方法でやるともっと速くなる可能性あり）

まずは、エクセル君を使えるようになった方がいいと思います。
エクセル君が使えると、「マクロの記録」という機能で、
操作がVBA語でいうと、どういう命令になるのか操作を翻訳してくれるので、
コードを調べることができます。

テキストファイルをエクセルに取り込むなら、
「テキストファイルのインポート」という機能（VBAでいうと、QueryTables.Add）が使えますし、
検索は、セルに入力するMatch関数(WorksheetFunction.Match)や、検索機能、
あるいはオートフィルターやフィルターオプションなどの機能が使えます。

そうすることで、開発の速度を上げることが可能かと思います。
（現状をブラッシュアップするにしても、一からExcel　VBAを勉強するにしても、いずれも、
長く険しい道だとは思います。）

提示のコードは以下のように簡略化できそうです。
（流し読みしかしてないので、そちらがやりたいことを、
こちらが勘違いしている可能性も大きいのですが＾＾；）

Sub テキストファイルをエクセルで見る()
    Dim vFName As Variant
    Dim rngTopLeft As Range
    Dim wshView As Worksheet

    Set wshView = ThisWorkbook.Worksheets("Sheet1")
    Set rngTopLeft = wshView.Range("A4")
    vFName = Application.GetOpenFilename("口座データ,*.txt")
    If vFName = False Then Exit Sub

    With wshView.QueryTables.Add(Connection:=vFName, _
                                 Destination:=rngTopLeft)
        .RefreshStyle = xlInsertDeleteCells
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuoteter = False
        .TextFileSpaceDelimiter = True
    End With
End Sub

Sub 名前の検索()
    Dim rngList As Range
    Dim sKey As String

    With ThisWorkbook.Worksheets("Sheet1")
        Set rngList = .Range("A4").CurrentRegion
        rngKeyWord = .Range("E5").Value
    End With

    On Error GoTo ErrHandler
    rngList.Rows(WorksheetFunction.Match(sKey, .Columns(1), 0)).Select
    On Error GoTo 0
    Exit Sub

ErrHandler:
    MsgBox "名前がありません。"
End Sub

また、こうした処理をする場合、テキストボックスを使用するのとセルに入力してもらうのとどちらの形の方が作りやすいですか?

セルにデータを入れると、
エクセル君が持っている既存の機能を存分に利用できますが、
テキストボックスだと、全ての機能を、現状のように全部自作する必要が出てきます。

あと、エクセル君は複数行を一度に編集することができるので
(良いところでもあり悪いところでもありますが)、
その辺を考慮してアプリケーションの開発をされるといいと思います。

Answer 3

誰かが書いたプログラムの修正ですか
そうだったら書き直すのは大変なので修正...っというのはいいのですが

main.executeSeachAndOutput(all) で処理が止まってしまうのですよね？
それは標準の関数ではないですよね?

それはどこで定義されていますか？
引数も Variant型なので
コードが無ければ どんな データを渡せば正常に動くのかも全く分かりません。

これでは 作った人にしか分かりません。
このままではいつまでたっても回答は付きませんよ?