[ExcelVBA] For Inputを使って検索して、行を一括コピーして貼り付けたい。

Question

あるスプレットシートが既にあり,そこにTextファイルから下記のようなデータをコピーしたいのですがよくできません。データが同じように並んでいて、Aの90という数値を検索したいと思っています。取得するデータはData2にあるAからDのデータを丸ごとコピー＆ペイストしたいのです。ペイストするときには、スペースとコンマで区切りを付けてペーストしたいと思っております。

Data１
A 90, B -23.3, C 0.5, D 9
A 90, B -42.5, C 0.4, D 9
A 45, B -21.6, C 0.25, D 9
A 90, B 23.5, C 0.7, D 9
Data2
A 90, B -23.3, C 0.5, D 9
A 90, B -42.5, C 0.4, D 9
A 45, B -21.6, C 0.25, D 9
A 90, B 23.5, C 0.7, D 9

ネットに載っているのをいろいろ試しましたが、すべてのセルに検索がかかり使えませんでした（アレンジできませんでした）。
どうぞよろしくお願いいたします。

siffon9 · Accepted Answer

> いろいろファイルの違うものに変更すると、
> If ary(1) = strFind Then　でまだ、「型が一致しません」のエラーがでています。

> しかし解決方法がネットでも見つかりません。うまい解決法はあるのでしょうか？

エラーが起きる具体的なテキストデータがわからないと、なんとも答えようがないです。

siffon9 · Answer

> Data2のところがもし”Row Data 2”となっている場合。If InStr(lineBuf, "Data2") <> 0 Then　のところは　 If InStr(lineBuf, "Row Data 2") <> 0 Then で良いと思います。 > ary = Split(lineBuf, " ") 'lineBufをスペースで分割する。 > If ary(1) = strFind Then 'Aの次の数字が検索文字ならば > > のary(1)はどこを指しているのでしょうか。”A”と簡単にしてましたが、実際は文字が入り”Act"です。 > また”lineBuf”もどこを指しているのでしょうか？ linBuf は、ファイルから読み取った一行分のデータです。（Line Input #fileNo, lineBuf で読み取っています） ary(1)については、例えば lineBuf = "A 90, B -23.3, C 0.5, D 9" だとすると。　ary = Split(lineBuf, " ") によって、スペース(" ")によって分割された要素がary(n)に代入されるので、　ary(0) = "A" 　ary(1) = "90," 　ary(2) = "B" 　…… 　ary(7) = "9" となります。従ってary(1)は、Aの次の数値+カンマになります。

siffon9 · Answer

補足いただいた内容に即して変更してみました。
・ファイルをダイアログで選択
・検索文字列（数字）を入力させる
・適合した行を空白で分割し、カンマを削除後、A列からH列に書き込む

----------------------------------
Sub aaa()
    Dim textFile As String
    Dim strFind As String
    Dim isData2 As Boolean: isData2 = False
    Dim targetCell As Range, target As Range
    Dim fileNo As Long
    Dim lineBuf As String
    Dim ary As Variant, e As Variant

textFile = Application.GetOpenFilename("Log File (*.log),*.log", 1, "Select LOG File")
    If textFile = "False" Then
        Exit Sub 'ファイル選択キャンセル時は終了
    End If
    strFind = InputBox("Input number(s)")  ' 検索文字列入力

strFind = strFind & "," ' カンマ追加
    Set targetCell = Range("A1") 'ペースト開始セル
    fileNo = FreeFile()
    Open textFile For Input As #fileNo
        Do Until EOF(fileNo)
            Line Input #fileNo, lineBuf
            If Not isData2 Then 'Data1部分は無視
                If InStr(lineBuf, "Data2") <> 0 Then
                    isData2 = True
                End If
            Else 'Data2部分
                Set target = targetCell
                
                ary = Split(lineBuf, " ") 'lineBufをスペースで分割する。
                If ary(1) = strFind Then  'Aの次の数字が検索文字ならば
                    For Each e In ary '分割した要素一つひとつについて
                        If right(e, 1) = "," Then '右端がカンマなら削除
                            e = left(e, Len(e) - 1)
                        End If
                        target.Value = e 'セルに書きこみ
                        Set target = target.Offset(0, 1) 'セルを一つ右へ
                    Next
                    Set targetCell = targetCell.Offset(1, 0) 'セルを一つ下へ移動
                End If
                
            End If
        Loop
    Close #fileNo
End Sub

siffon9 · Answer

仕様がいまひとつ理解できなかったので、間違っていたらゴメンなさい。

以下の動作をします。
・指定のテキストファイルを開き、一行ずつ読み込む
・「Data2」行までは何もしないで読み捨てる。
・「検索文字列」で始まる行があったら、順にA1セルから下に向かってペーストする。

質問欄のデータですとA1～A3セルにData2の”A 90"で始まる3行が書き込まれます。

--------------------------------------------------
Sub aaa()
    Dim textFile As String
    Dim strFind As String
    Dim isData2 As Boolean: isData2 = False
    Dim targetCell As Range
    Dim fileNo As Long
    Dim lineBuf As String
    
    textFile = ThisWorkbook.Path & "\sample.txt" 'テキストファイル
    strFind = "A 90" ' 検索文字列
    strFind = strFind & "," 'カンマを追加
    Set targetCell = Range("A1") 'ペースト開始セル

fileNo = FreeFile()
    Open textFile For Input As #fileNo
        Do Until EOF(fileNo)
            Line Input #fileNo, lineBuf
            If Not isData2 Then 'Data1部分は無視
                If InStr(lineBuf, "Data2") <> 0 Then
                    isData2 = True
                End If
            Else 'Data2部分
                If InStr(lineBuf, strFind) = 1 Then '検索文字列で始まる行ならば
                    targetCell.Value = lineBuf
                    Set targetCell = targetCell.Offset(1, 0) 'セルを一つ下へ移動
                End If
            End If
        Loop
    Close #fileNo
End Sub

[ExcelVBA] For Inputを使って検索して、行を一括コピーして貼り付けたい。

> いろいろファイルの違うものに変更すると、

> Data2のところがもし”Row Data 2”となっている場合。

補足いただいた内容に即して変更してみました。

仕様がいまひとつ理解できなかったので、間違っていたらゴメンなさい。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング