2

Excelマクロの作成を検討し始めたばかりなので、何か助けていただければ幸いです。

約 1,500 行で、列の長さが 16 ～ 18 の可変長の Excel ドキュメントがあります。ファイルの各行を新しい .txt ファイルに書き込みたいと思います (実際には、.pdf として書きたいと思いますが、それは可能ではないと思います)。ファイルの名前は、対応する最初の列です。 . さらに、各行を改行で区切りたいと思います。したがって、理想的には、マクロは 1) 各行を新しい .txt ファイル (または可能であれば .pdf) としてエクスポートし、2) 各ファイルに ColumnA という名前を付け、3) 新しい .txt ファイルのそれぞれのコンテンツには ColumnsB-length が含まれます。列の合計 4) 各列は新しい行で区切られます。

たとえば、ドキュメントが次のようになっているとします。

列 1//列 2// 列 3

a//a1//a2

b//b1//b2

「a」、「b」という名前の2つのファイルとして出力したい。例として、ファイル「a」の内容は次のようになります。

a1

a2

私の質問の別々の部分に対処している他の2つのスタックオーバーフロースレッドを見つけましたが、それらをつなぎ合わせる方法について途方に暮れています.

各列の間に改行がある新しい .txt ファイルへの各行 (ただし、ファイル名は ColumnA ではありません): Excel スプレッドシートのすべての行からテキスト ファイルを作成します。

ファイルに組み込まれる列は 1 つだけですが、ファイル名は ColumnA に対応します: Excel の行を一連のテキスト ファイルに出力する

助けてくれてありがとう！

4

4 に答える 4

4

ファイルの最後までコンテンツを列 B にするには、次のようにします。

列 B のセルに対して単純なループを作成します。これにより、各行の列の範囲が定義され、列 A の値に基づいてファイル名も設定されます。

Sub LoopOverColumnB()

Dim filePath as String
Dim fileName as String
Dim rowRange as Range
Dim cell as Range

filePath = "C:\Test\" '<--- Modify this for your needs.

For each cell in Range("B1",Range("B1048576").End(xlUp))
   Set rowRange = Range(cell.address,Range(cell.address).End(xlToRight))

   fileName = filePath & cell.Offset(0,-1).Value

   '
   ' Insert code to write the text file here 
   '
   ' you will be able to use the variable "fileName" when exporting the file
Next
End Sub
于 2013-03-21T18:10:01.640 に答える
1

@Davidと@Exactaboxのおかげで、私は問題を解決するために以下をつなぎ合わせました。信じられないほど効率が悪く、冗長なビットがありますが、実行されます (非常に遅い)。誰かがそれをクリーンアップする方法を見つけることができれば、遠慮なく言ってください。

[編集] 残念ながら、このマクロは各行を適切な名前の新しい .txt ファイルとしてエクスポートしますが、各テキスト ファイルの内容はドキュメントの最後の行であることに気付きました。そのため、20 行すべてを適切なファイル名と正しい形式で 20 個の .txt ファイルとしてエクスポートしたとしても、20 個の各ファイルの実際の内容は同じです。これを修正する方法がわかりません。

Sub SaveRowsAsTXT()

Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long
Dim filePath As String
Dim fileName As String
Dim rowRange As Range
Dim cell As Range

filePath = "C:\filepath\"

For Each cell In Range("B1", Range("B1048576").End(xlUp))
   Set rowRange = Range(cell.Address, Range(cell.Address).End(xlToRight))

   fileName = filePath & cell.Offset(0, -1).Value

    Set wsSource = ThisWorkbook.Worksheets("Sheet1")

    Application.DisplayAlerts = False 'will overwrite existing files without asking

    r = 1
    Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
        ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
        Set wsTemp = ThisWorkbook.Worksheets(1)

        For c = 2 To 16
            wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
        Next c

        wsTemp.Move
        Set wbNew = ActiveWorkbook
        Set wsTemp = wbNew.Worksheets(1)
        wbNew.SaveAs fileName & ".txt", xlTextWindows 'save as .txt
        wbNew.Close
        ThisWorkbook.Activate
        r = r + 1
    Loop

    Application.DisplayAlerts = True

Next
End Sub
于 2013-03-27T17:43:54.050 に答える