「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



