VBA ブックを読み込んでセルの値をテキストに出力する

「Excelブックのあるシートのある範囲のセルの値を、テキストに出力したい。」

・・・こんな話を毎年のように聞くにもかかわらず、「VBAを用意するまでもない!シートの内容をコピペすればいい!」なんて話もよく聞きます。

機械的な作業を強いるくらいなら、精密な機械に任せろ!という思いから、

毎度調べてVBAで書くのも手間がかかるので、基本的な動作をするテンプレ的なVBAマクロツールを用意してみました。

よかったら流用してみてください。万一バグがあったらご報告いただけると幸いです。(ちなみに環境はExcel、Kingsoft Office(WPS)で動作確認しています)

◆ツール実行画面(テンプレでは対象件数を20行までに限定してます)

◆読み込み対象のファイルのサンプル(任意)↓H4:I13に出力したいテキスト(式)を記載しています。

※なお、参考までに[値]でなく[式]には不要な" "を入れ、ツールで[式]の" "を除く処理を入れています。不要な場合はソースを確認して削除してください。

◆上記読み込み対象サンプルの出力結果のイメージです。

(9/19追記)オートフィルタで非表示にした行を出力対象外にする例を追加しました。

学習目的でソースだけを流用したい人は以下を参考にしてください。

Public Type LoaderInfo
    FilePath As String
    SheetName As String
    Range As String
    OutputFileName As String
End Type

Private Sub CommandButton1_Click() Dim wkBook As Workbook Dim wkSheet As Worksheet Dim wkLoaderInfo(20) As LoaderInfo Dim wkRange As Range Dim wkStartRow As Long Dim wkEndRow As Long Dim wkStartCol As Long Dim wkEndCol As Long '配列の設定 For i = 1 To UBound(wkLoaderInfo) wkLoaderInfo(i).FilePath = ActiveSheet.Cells(2 + i, 1).Text wkLoaderInfo(i).SheetName = ActiveSheet.Cells(2 + i, 2).Text wkLoaderInfo(i).Range = ActiveSheet.Cells(2 + i, 3).Text wkLoaderInfo(i).OutputFileName = ActiveSheet.Cells(2 + i, 4).Text Next i For i = 1 To UBound(wkLoaderInfo) If wkLoaderInfo(i).FilePath = "" Then '空文字の場合はなにもしない GoTo ContinueFor1 End If If Dir(wkLoaderInfo(i).FilePath) = "" Then MsgBox ("ファイルが読み込めませんでした。" + vbCrLf + wkLoaderInfo(i).FilePath) GoTo ContinueFor1 End If 'ブックを開く Set wkBook = Workbooks.Open(wkLoaderInfo(i).FilePath, , True) 'シートをアクティブにする Set wkSheet = wkBook.Sheets(wkLoaderInfo(i).SheetName) wkSheet.Activate 'シート内の指定範囲を選択する Set wkRange = wkSheet.Range(wkLoaderInfo(i).Range) '処理対象の範囲を設定 wkStartRow = wkRange.Cells(1).Row wkStartCol = wkRange.Cells(1).Column wkEndRow = wkRange.Cells(wkRange.Count).Row wkEndCol = wkRange.Cells(wkRange.Count).Column Open wkLoaderInfo(i).OutputFileName For Output As #1 For j = wkStartCol To wkEndCol For k = wkStartRow To wkEndRow If Not wkSheet.Cells(k, j).EntireRow.Hidden Then 'オートフィルタ等で行を非表示にしている場合は対象外にする '特別な処理をここに書く(例:計算式に半角スペースがあれば削除する) wkSheet.Cells(k, j).Formula = Replace(wkSheet.Cells(k, j).Formula, " ", "") '値が設定されていれば出力する If wkSheet.Cells(k, j).Value <> "" Then Print #1, wkSheet.Cells(k, j).Value End If End If Next k Next j Close #1 wkBook.Close False ContinueFor1: Next i MsgBox ("処理が完了しました。") End Sub
タイトルとURLをコピーしました