使用excel VBA查找每列中最后使用的行数

我正在尝试使用VBA获取特定工作表每列中最后使用的行数。我已经编写了代码，但这只打印第一列的行数。您能帮我找到每列中最后使用的行吗。请找到密码

Dim row As Long
Dim i As Integer
Dim j As Integer
Dim a As String
Dim b As Range
Dim myrange As Range
Dim count As Integer
Dim url As String
Dim lastRow, lRow As Long
Dim iCntr, jCntr, iMaxRow As Integer
Dim vMax
Dim arr2(18)


For iCntr = 1 To 18 ' for each column
     vMax = 0
     iMaxRow = 2
     
    'Finding last Row of current Column
    With ActiveSheet
        lastRow = .Cells(.Rows.count, iCntr).End(xlUp).row
    End With
    arr2(iCntr - 1) = lastRow
Next

Worksheets("Sheet1").Range("B2:B18").Value = arr2

尝试：

输出：

---

我已经编写了代码，但这只打印每列第一列的行数

主代码没有问题。问题在于将输出写入“表1”的方式

改变

Worksheets("Sheet1").Range("B2:B18").Value = arr2

到

在上测试

输出

收集最后一行

• 第一个代码是对您的问题的快速修复。仍然不推荐使用
• 第二段代码展示了使用常量、完全注释工作表和范围以及注释代码的优点（请注意，此代码注释过多，通常只注释其中的部分）

提示

• 解释了为什么我们不再使用

  Integer

• 尝试避免任何风格的

  Active

  ，例如

  ActiveWorkbook

  ，

  ActiveSheet

  ，

  ActiveCell

• 使用变量。使用有意义的名称（表现不佳）。此外，还可以为他们起个名字
• 在一行中声明变量时要小心：

  Dim x As…，y As…，z As…

• 在第二段代码中，如果在此阶段声明所需的变量过于混乱，请将所有这些

  Dim

  s复制到常量之后的代码开头，以使其更易于阅读

代码

Option Explicit

Sub LastRowsQF()
    Dim row As Long
    Dim i As Integer
    Dim j As Integer
    Dim a As String
    Dim b As Range
    Dim myrange As Range
    Dim count As Integer
    Dim url As String
    Dim lastRow As Long, lRow As Long
    ' Not:
    'Dim lastRow, lRow As Long ' Wrong!
    Dim iCntr As Integer, jCntr As Integer, iMaxRow As Integer
    ' Not:
    'Dim iCntr, jCntr, iMaxRow As Integer ' Wrong!
    Dim vMax
    ' This means 18 rows by 1 column.
    Dim arr2(1 To 18, 1 To 1)
    ' Not:
    ' This means 1 row with 19 columns (elements)!
    'Dim arr2(18)
    
    For iCntr = 1 To 18 ' for each column
         'vMax = 0 ' Not used.
         'iMaxRow = 2 '  Not used.
         
        'Finding last Row of current Column
        With ActiveSheet
            lastRow = .Cells(.Rows.count, iCntr).End(xlUp).row
        End With
        arr2(iCntr, 1) = lastRow
    Next
    
    Worksheets("Sheet1").Range("B2:B19").Value = arr2

End Sub

Sub LastRows()
    
    ' Constants
    Const srcNumberOfColumns As Long = 18 ' Source Number of Columns
    Const tgtName As String = "Sheet1"    ' Target Worksheet Name
    Const tgtFirstCell As String = "B2"   ' Target First Cell Range Address
    
    ' Define workbook ('wb').
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containig this code.
    
    ' Define Source Worksheet ('ws').
    Dim ws As Worksheet
    Set ws = wb.ActiveSheet ' e.g. wb.worksheets("Sheet2") is preferred.
    
    ' Define (2D one-based one-column) Data Array ('Data').
    Dim Data As Variant
    ReDim Data(1 To srcNumberOfColumns, 1 To 1)
    
    ' Write last row of each column to rows of Data Array.
    Dim j As Long
    For j = 1 To srcNumberOfColumns
        Data(j, 1) = ws.Cells(ws.Rows.count, j).End(xlUp).row
    Next
    
    ' Define Target Worksheet ('ws').
    ' Note: Use a different variable if you still need to use Source Worksheet.
    Set ws = wb.Worksheets(tgtName)
    
    ' Define Target Range ('rng').
    Dim rng As Range
    Set rng = ws.Range(tgtFirstCell).Resize(UBound(Data, 1))
    
    ' Write values from Data Array to Target Range.
    rng.Value = Data

End Sub

---

“每列第一列的行数”？

'~~> Note: It has to be 19 and not 18. If there are 18 columns and so on
Worksheets("Sheet1").Range("B2:B19").Value = Application.Transpose(arr2)

Option Explicit

Sub LastRowsQF()
    Dim row As Long
    Dim i As Integer
    Dim j As Integer
    Dim a As String
    Dim b As Range
    Dim myrange As Range
    Dim count As Integer
    Dim url As String
    Dim lastRow As Long, lRow As Long
    ' Not:
    'Dim lastRow, lRow As Long ' Wrong!
    Dim iCntr As Integer, jCntr As Integer, iMaxRow As Integer
    ' Not:
    'Dim iCntr, jCntr, iMaxRow As Integer ' Wrong!
    Dim vMax
    ' This means 18 rows by 1 column.
    Dim arr2(1 To 18, 1 To 1)
    ' Not:
    ' This means 1 row with 19 columns (elements)!
    'Dim arr2(18)
    
    For iCntr = 1 To 18 ' for each column
         'vMax = 0 ' Not used.
         'iMaxRow = 2 '  Not used.
         
        'Finding last Row of current Column
        With ActiveSheet
            lastRow = .Cells(.Rows.count, iCntr).End(xlUp).row
        End With
        arr2(iCntr, 1) = lastRow
    Next
    
    Worksheets("Sheet1").Range("B2:B19").Value = arr2

End Sub

Sub LastRows()
    
    ' Constants
    Const srcNumberOfColumns As Long = 18 ' Source Number of Columns
    Const tgtName As String = "Sheet1"    ' Target Worksheet Name
    Const tgtFirstCell As String = "B2"   ' Target First Cell Range Address
    
    ' Define workbook ('wb').
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containig this code.
    
    ' Define Source Worksheet ('ws').
    Dim ws As Worksheet
    Set ws = wb.ActiveSheet ' e.g. wb.worksheets("Sheet2") is preferred.
    
    ' Define (2D one-based one-column) Data Array ('Data').
    Dim Data As Variant
    ReDim Data(1 To srcNumberOfColumns, 1 To 1)
    
    ' Write last row of each column to rows of Data Array.
    Dim j As Long
    For j = 1 To srcNumberOfColumns
        Data(j, 1) = ws.Cells(ws.Rows.count, j).End(xlUp).row
    Next
    
    ' Define Target Worksheet ('ws').
    ' Note: Use a different variable if you still need to use Source Worksheet.
    Set ws = wb.Worksheets(tgtName)
    
    ' Define Target Range ('rng').
    Dim rng As Range
    Set rng = ws.Range(tgtFirstCell).Resize(UBound(Data, 1))
    
    ' Write values from Data Array to Target Range.
    rng.Value = Data

End Sub