[[20180710155913]]　『マクロでテキストファイルを回したい』（ココ）　ページの最後に飛ぶ

『マクロでテキストファイルを回したい』（ココ）

名前が連番になっているテキストファイル(○○○1.txt,○○○2.txt,…)があるのですが、これをマクロで順番に取り込みをしたいのですがどうすればよいですか？
取り込んだ後計算結果を入力するようにしたいので、for文で回したいのです。

順番としては
○○○1を取り込み→計算結果(セル１つ分)を別のシートにコピぺ→○○○2を取り込み(上書き)→先ほどのコピペの下にコピペ→繰り返し…

テキストファイルは同じフォルダーに入っています。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

テキストファイルの中身は、1行1データになっているとか、何か規則性のある並びなのですか？それとも、1ファイルで1文章であり、自由に改行されていたりするのですか？つまり、1ファイルを1セルに代入してしまって良いのでしょうか？ inputとoutputの形を明確にしてください。

連番なら、For文でループさせて、"○○○" & i & ".txt" なんかをファイル名にすれば、簡単に順番に読み込めるかと思いますが、ご自分で書いてみたコードは無いのでしょうか？
（???） 2018/07/10(火) 16:27

早い返答ありがとうございます。

テキストファイルの中身は“カンマやタブなどの区切り文字によってフィールドごとに区切られたデータ”であり、フィールドの区切り文字は“タブ”で、列のデータ形式は“G/標準”です。
一応自分でマクロの記録機能で書かれたものを変えてみたのですが、

Sub a()
'
' a Macro
'

    Dim i As Integer
    For i = 1 To 3

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;F:\○○○\○○○\○○○1.txt", Destination:=Range("$A$1"))
        .CommandType = 0
        .Name = "○○○1_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("450~650_3 ").Select
    Range("B9").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Cells(i, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet3").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.QueryTable.Delete
    Selection.ClearContents

    Next i
End Sub

ファイル名と保存場所のみ○○○に変えてあります。

（ココ） 2018/07/10(火) 16:48

QueryTables.Add を使ったのですね。その割には、全ての列が標準型のままなので、勿体ない使い方に見えますが、とりあえずそのまま生かします。
どうやら元ファイルは先頭行がすべて項目名になっているようなので、そのまま取り込むと、先頭行が沢山混じってしまいます。だから、最初のファイルだけ先頭行を使い、後は2行目以降だけ転記するようにします。あと、取り込む度に名前定義が増えるので、全部消して、毎回1から始まるように名前変更してみました。全部消すのがまずいようなら、先頭が "○○○" なものだけを消すように判定追加してください。

あとは、複数シート利用していたり、そこからセルをコピペしている箇所は意味が判らなかったので、外しました。必要なら復活させてください。

 Sub test()
    Const cPATH = "F:\○○○\○○○\"
    Dim wk As Worksheet
    Dim cFile As String
    Dim i As Long
    Dim iR As Long
    Dim iDim(309) As Long

    Set wk = Sheets("Sheet1")
    wk.Cells.Delete
    For i = wk.Names.Count To 1 Step -1
        wk.Names(i).Delete
    Next i

    For i = 0 To UBound(iDim)
        iDim(i) = xlGeneralFormat
    Next i

    For i = 1 To 3
        iR = wk.Cells(wk.Rows.Count, "A").End(xlUp).Row
        If 1 < iR Then
            iR = iR + 1
        End If
        cFile = "○○○" & i & ".txt"
        With wk.QueryTables.Add(Connection:="TEXT;" & cPATH & cFile, Destination:=wk.Cells(iR, "A"))
            .FieldNames = IIf(iR = 1, True, False)
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 932
            .TextFileStartRow = IIf(iR = 1, 1, 2)
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = iDim
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False

            wk.Names(wk.Names.Count).Name = "○○○_" & i
        End With
    Next i
 End Sub
（???） 2018/07/10(火) 17:35

返信遅くなり申し訳ありません。
自分の説明不足でした。
読み込むテキストファイルは解析に使用しているファイル(640行302列)でして一行目から数字の羅列で、ファイルごとに全て数値が違うのです。

現在の仕様は“sheet1”にテキストファイルを読み込ませると、“sheet2”でsheet1のセルを参照して計算し、“450~650_3”でsheet2のセルを参照してセル一つ分の答えを出すのです。その答えをコピーし“sheet3”に値をB列に上から順番にペーストし記録します。

これを自動化したいのです。後半の部分はこの結果を記録する部分です。

また、新しくファイルを読み込ませるときは削除ですと参照が外れてしまいますので、クリアをしていただきたいのです。

自分で手を加えたものがこちらです。

Sub あ()

    Const cPATH = "F:\○○○\○○○\"
    Dim wk As Worksheet
    Dim cFile As String
    Dim i As Long
    Dim iR As Long
    Dim iDim(309) As Long
    Set wk = Sheets("Sheet1")
    wk.Cells.Delete
    For i = wk.Names.Count To 1 Step -1
        wk.Names(i).Delete
    Next i
    For i = 0 To UBound(iDim)
        iDim(i) = xlGeneralFormat
    Next i
    For i = 1 To 3
        iR = wk.Cells(wk.Rows.Count, "A").End(xlUp).Row
        If 1 < iR Then
            iR = iR + 1
        End If
        cFile = "○○○" & i & ".txt"
        With wk.QueryTables.Add(Connection:="TEXT;" & cPATH & cFile, Destination:=wk.Cells(iR, "A"))
            .FieldNames = IIf(iR = 1, True, False)
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 932
            .TextFileStartRow = IIf(iR = 1, 1, 2)
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = iDim
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            wk.Names(wk.Names.Count).Name = "○○○_" & i
        End With
         Sheets("450~650_3 ").Select
    Range("B9").Select
    Selection.Copy
    Sheets("Sheet3").Select
    Cells("i,2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
    Next i
 End Sub

このままですと、下から10行目の　Cells("i,2").Select　で、実行時エラー5 プロシージャの呼び出し、または引数が不正です　と出てきます。

（ココ） 2018/07/11(水) 13:11

 はじめに書かれたVBAだと
 >Cells(i, 2).Select
 となっているが？
（ねむねむ） 2018/07/11(水) 13:22

始めはもっと前の段階でエラーが発生していました
（ココ） 2018/07/11(水) 17:11

新たにSheet2とか出てきましたが、コード中には登場していないし、1行目から数字だ、という割には1行目をタイトル行にしたままだし、具体的にどの行でどんなエラーに出たのか書いてもらえないし、何がどうなっているのかよく判りません。

少なくとも、複数テキストファイルを1つのシートにまとめる例は書いたので、あとは自由に応用してみてください。私のコードに無い部分でエラーが出ても、それはご自身で作りこんだエラーなのですから。
（???） 2018/07/11(水) 18:06

 話が通じてない様なので、

 ＞Cells("i,2").Select
 　　↓
 　Cells(i,2).Select

 カッコ内が文字になっていますよ、ってこと。

（半平太） 2018/07/11(水) 20:01

皆様回答ありがとうございます。
マクロを使うのは初めてなので、頓珍漢な質問をしていたと思います。
自分にはまだまだ高度な技術のようです。
別の方法を探してみようと思います。
重ね重ねになりますが、付き合って下さいました皆様ありがとうございます。
一旦ここまでにしたいと思います。
（ココ） 2018/07/12(木) 12:38

コメント返信：

[ 一覧(最新更新順) ]

[[20180710155913]] 『マクロでテキストファイルを回したい』（ココ） ページの最後に飛ぶ

[[20180710155913]]　『マクロでテキストファイルを回したい』（ココ）　ページの最後に飛ぶ