excel - 无法运行 vba 功能

Question

我一直在尝试运行此函数来计算当前工作簿中每张工作表中的行数。我从之前回答的问题中得到了这个功能。

但是，当我尝试运行它时，它要求我创建一个宏，当我这样做时它会创建一个“Sub ()”，当我将函数放入其中时，它会给我“Expected End Sub”的错误我'我不知道该怎么办。我尝试了各种重写代码的方法，但无济于事。

我是 vba 新手，不确定这里有什么问题。

Function Test_It()
    For Each Sheet In ThisWorkbook.Sheets
        Debug.Print Sheet.Name & vbTab & CountMyRows(Sheet.Name)
    Next Sheet
End Function


Function CountMyRows(SName) As Long         '# where SName is the name of a sheet
    Dim rowCount As Long
    rowCount = Worksheets(SName).UsedRange.Rows.Count
    CountMyRows = rowCount
End Function

标签： excelvba

Answer 1

Function在 a 中使用Sub

• 请注意，Sheets（对象的）集合Workbook还包括没有UsedRange.
• 在编写引用对象的函数时，最好将对象用作参数。例如，在您的函数版本中，您使用的是不合格的Worksheets(SName)，我们不知道它属于哪个工作簿。所以如果ThisWorkbookinSub不活跃，函数可能会失败或者可能无法写入正确的结果。

Option Explicit

Sub Test_It()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print ws.Name & vbTab & CountMyRows(ws)
        ' Without the function (the function is kind of useless):
        'Debug.Print ws.Name & vbTab & ws.UsedRange.Rows.Count
    Next ws
End Sub

Function CountMyRows(ByVal ws As Worksheet) As Long
    If ws Is Nothing Then Exit Function
    CountMyRows = ws.UsedRange.Rows.Count
End Function

编辑

一个更实际的例子

以下将工作表名称和ThisWorkbook（包含此代码的工作簿）的相应“使用范围行数”写入新工作簿的第一个工作表。

Sub testRowsCount()
    
    ' Add a new (destination) workbook and create a reference
    ' to its first (destination) worksheet.
    Dim dws As Worksheet: Set dws = Workbooks.Add.Worksheets(1)
    
    ' Write headers.
    dws.Cells(1, "A").Value = "Name"
    dws.Cells(1, "B").Value = "RowsCount"
    ' Define destination rows counter.
    Dim n As Long: n = 1
    
    Dim sws As Worksheet
    
    ' Loop through the worksheets collection (all worksheets)
    ' of the Source Workbook and write the names and used range
    ' rows counts to the Destination Worksheet.
    For Each sws In ThisWorkbook.Worksheets
        n = n + 1
        dws.Cells(n, "A").Value = sws.Name
        dws.Cells(n, "B").Value = CountMyRows(sws)
    Next sws

    dws.Parent.Saved = True ' for easy closing only.

End Sub