Myマクロは、アクティブブック内のすべてのシートのすべてのデータを書き込むことによって大きなテキストファイルを作成します。すべての関連するセルのExcel VBA範囲
各ワークシートでは、テキストファイルに保存される特定の矩形範囲のセルを決定する必要があります。左上隅は常にA1になりますが、右下隅は、範囲にすべてのセルが含まれるように選択する必要があります(書式設定は関係ありません)。
私はws.Range( "A1")と思っていましたが、CurrentRegionはトリックを行いますが、A1と近くのセルが空の場合は動作しません。シート内のデータを含む唯一のセルがQ10の場合、範囲はA1:Q10でなければなりません。
もちろん、興味のある範囲を見つけるためにws.Cellsの範囲をループすることができますが、それはかなり時間がかかります。より効果的な方法があることを願っています。シート内のすべてのセルを選択してメモ帳にコピー貼り付けすると、何百もの空の列と何千もの空の行が表示されることはなく、関連するデータだけがコピーされます。問題はVBAでそれを複製する方法です。 A1に何があるかどう
Sub CreateTxt()
'This macro copies the contents from all sheets in one text file
'Each sheet contents are prefixed by the sheet name in square brackets
Dim pth As String
Dim fs As Object
Dim rng As Range
pth = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Dim outputFile As Object
Set outputFile = fs.CreateTextFile(pth & "\Output.txt", True)
Dim WS_Count As Integer
Dim ws As Worksheet
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Set ws = ActiveWorkbook.Worksheets(I)
outputFile.WriteLine ("[" & ws.Name & "]")
Debug.Print ws.Name
Set rng = ws.Range("A1").CurrentRegion
outputFile.WriteLine (GetTextFromRangeText(rng, vbTab, vbCrLf))
Next I
outputFile.Close
End Sub
Function GetTextFromRangeText(ByVal poRange As Range, colSeparator As String, rowSeparator As String) As String
Dim vRange As Variant
Dim sRow As String
Dim sRet As String
Dim I As Integer
Dim j As Integer
If Not poRange Is Nothing Then
vRange = poRange
Debug.Print TypeName(vRange)
For I = LBound(vRange) To UBound(vRange)
sRow = ""
For j = LBound(vRange, 2) To UBound(vRange, 2)
If j > LBound(vRange, 2) Then
sRow = sRow & colSeparator
End If
sRow = sRow & vRange(I, j)
Next j
If sRet <> "" Then
sRet = sRet & rowSeparator
End If
sRet = sRet & sRow
Next I
End If
GetTextFromRangeText = sRet
End Function
:B2細胞は、このマクロ作品
これは、これまでのところ、私のコードです。 A1:B2が空で、CurrentRegionプロパティがEmptyを返すと、ブレークします。
あなたは試しに範囲( "A1")を持っていますか?特別なセル(xllastcell)? – Rosetta
ありがとうございます、SpecialCellsメソッドを指摘すると、これを思い出すのに役立ちました: 'ws.Range(" A1: "&ws.Cells.SpecialCells(xlLastCell).Address)' – Passiday