Question

我的宏通过写入活动工作簿中所有工作表的所有数据来创建一个大文本文件。

在每个工作表中，有必要确定将保存在文本文件中的某个矩形范围的单元格。它的左上角始终为A1，但应选择右下角，以便范围包括具有任何内容的所有单元格（格式无关紧要）。

我认为ws.Range（＆＃34; A1＆＃34;）。CurrentRegion可以解决问题，但是当A1和附近的单元格为空时它不起作用。如果表中数据的唯一单元格是Q10，则范围应为A1：Q10。

当然，我可以遍历ws.Cells范围以发现感兴趣的范围，但这非常耗时，我希望有更有效的方法。如果我选择工作表中的所有单元格并复制粘贴到记事本，我最终不会有数百个空列和数千个空行，只会复制相关数据。问题是如何使用VBA复制它。

到目前为止，这是我的代码：

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

如果A1：B2单元格中有任何内容，则此宏可以正常工作。当A1：B2为空且CurrentRegion属性返回Empty时，它会中断。

Answer 1

我认为您应该使用这些函数来查找最后一行/列

lastRow = Sheets("Sheetname").Cells(Rows.Count, 1).End(xlUp).Row

lastCol = Sheets("Sheetname").Cells(1, Columns.Count).End(xlToLeft).Column

指定工作表的名称和要查找包含信息的最后一个单元格的行/ columb-number，并返回它的编号。

（在示例中，第一列中的最后一行，第一行中的最后一列是find）

lastCol会给你一个长的asnwer。如果要将此数字转换为列字母，可以使用下一个函数

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

我希望你找到这个有用的

Answer 2

感谢用户Rosetta，我已经为所寻求的范围提出了这个表达式：

ws.Range("A1:" & ws.Cells.SpecialCells(xlLastCell).Address)

所有相关单元格的Excel VBA范围

2 个答案: