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

我的宏通过写入活动工作簿中所有工作表的所有数据来创建大型文本文件。所有相关单元格的Excel VBA范围

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

我以为ws.Range（“A1”）.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属性返回空时，它会中断。

来源

2016-11-30 Passiday

你有尝试范围（“A1”）。specialcells（xllastcell）？ – Rosetta

谢谢，你指出的SpecialCells方法帮助我想出了这个：'ws.Range（“A1：”＆ws.Cells.SpecialCells（xlLastCell）.Address）' – Passiday

由于用户罗塞塔，我想出了这个表达式的追捧范围：

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

来源

2016-11-30 15:24:26 Passiday

我认为你应该使用这些功能来找到最后行/列

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

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

您指定的表，要找到信息的最后一个单元格的行/库仑数的名称，并返回它的数量。

（在这个例子中的最后一排的第一列，最后一列在第一行是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

我希望你发现这很有

来源

2016-11-30 12:23:59

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

回答

相关问题