質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.50%

  • VBA

    2315questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

VBAでtxtを検索

解決済

回答 3

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 464

yuurin

score 1

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

わからないなりに書き換えてみましたが、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 >

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • aki.aki.

    2019/02/22 17:51

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

    キャンセル

  • ttyp03

    2019/02/22 18:17

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

    キャンセル

回答 3

+3

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

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

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

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/25 09:25

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

    キャンセル

  • この投稿は削除されました

  • 2019/02/25 11:09 編集

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

    キャンセル

  • 2019/02/25 16:14

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

    キャンセル

checkベストアンサー

0

なが~いコードが書いてあるけど、
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

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

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

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

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

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

同じタグがついた質問を見る

  • VBA

    2315questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。