vba 旧函数改为 return 行计数 returns 1

Question

我正在处理一些我想构建的遗留代码，但我似乎无法弄清楚以下内容：为什么函数 AantalZichtbareRows return 1？它说 For Each row In rng.Rows 行数是 1500 左右（我正在使用的实际 excel 也是如此）。

我特别困惑n = r.Areas.Count。这就是 1 的起源。

Sub motivatieFormOpmaken()

Public iLaatsteKolom As Integer
Public iLaatsteRij As Integer
Public iKolomnrCorpID As Integer
Public iKolomnrNaam As Integer
Public iKolomnrHuidigeFunctie As Integer

Const StBestand = "Stambestand.xlsm"
Const motivatie = "Template motivatieformulier opstapregeling.xlsx"

    Dim wbMotivTemp As Workbook
    Dim wsMotiv As Worksheet
    Dim PathOnly, mot, FileOnly As String
    Dim StrPadSourcenaam As String

    Set wbMotivTemp = ThisWorkbook
    Set wsMotiv = ActiveSheet

    StrHoofdDocument = ActiveWorkbook.Name
    StrPadHoofdDocument = ActiveWorkbook.Path
    StrPadSourcenaam = StrPadHoofdDocument & "\" & c_SourceDump

    If Not FileThere(StrPadSourcenaam) Then
       MsgBox "Document " & StrPadSourcenaam & " is niet gevonden."
    Exit Sub
    End If

    Application.ScreenUpdating = False

    Workbooks.Open FileName:=StrPadSourcenaam
    Application.Run "Stambestand.xlsm!unhiderowsandcolumns"
    Worksheets("stambestand").Activate

    iLaatsteKolom = Worksheets("stambestand").Cells.SpecialCells(xlLastCell).Column
    iLaatsteRij = Worksheets("stambestand").Cells.SpecialCells(xlLastCell).row

    VulKolomNr
    If KolomControle = False Then Exit Sub

    Aantalregels = AantalZichtbareRows
        Dim rng As Range
        Dim row As Range
        Dim StrFileName As String
        'If Aantalregels > 1 Then
         Set rng = Selection.SpecialCells(xlCellTypeVisible)
         For Each row In rng.Rows
              iRijnummer = row.row
              If iRijnummer > 1 Then
                 wsMotiv.Range("motiv_cid") = Cells(iRijnummer, iKolomnrCorpID).Text
                 wsMotiv.Range("motiv_naam") = Cells(iRijnummer, iKolomnrNaam).Text
                 wsMotiv.Range("motiv_ldg") = Cells(iRijnummer, iKolomnrHuidigeLeidingGevende).Text

                 n = naamOpmaken
                 wbMotivTemp.Activate
                 ActiveWorkbook.SaveAs FileName:=StrPadHoofdDocument & "\Docs\" & n & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
              End If
         Next row

End Sub

Function naamOpmaken() As String
    Dim rng As Range
    Dim row As Range
    Set rng = Selection.SpecialCells(xlCellTypeVisible)

    iRijnummer = rng.row
        If iRijnummer > 1 Then
            naam = Cells(iRijnummer, iKolomnrNaam).Text
            ldg = Cells(iRijnummer, iKolomnrHuidigeLeidingGevende).Text
            cid = Cells(iRijnummer, iKolomnrCorpID).Text

            Dim Position As Long, Length As Long
            Dim n As String
            Position = InStrRev(naam, " ")
            Length = Len(naam)
            n = Right(naam, Length - Position)
        End If
    naamOpmaken = n + "-" + ldg + "-" + cid
End Function

Public Function AantalZichtbareRows() As Integer
    Dim rwCt As Long
    Dim r As Range
    Dim n As Long
    Dim I As Long
        Set r = Selection.SpecialCells(xlCellTypeVisible)
        n = r.Areas.Count
            For I = 1 To n
              rwCt = rwCt + r.Areas(I).Rows.Count
            Next I
        AantalZichtbareRows = rwCt
End Function

Answer 1

Range.areas指定选择区域的个数。 Range.Areas

我测试了你的代码，它按预期工作。您可以有一个包含 1500 行的选择区域。示例："A1:A1500" 或者您可以选择包含 2 个区域，每个区域三行，总共 6 行。示例："A1:A3" 和 "C4:C6".

此代码可能会帮助您了解该方法如何 returns 有关所选单元格的信息。

Public Function AantalZichtbareRows() As Integer
    Dim rwCt As Long
    Dim rwCt2 As Long
    Dim r As Range
    Dim n As Long
    Dim I As Long

    Set r = Selection.SpecialCells(xlCellTypeVisible)
    n = r.Areas.Count
    For I = 1 To n
      rwCt = rwCt + r.Areas(I).Rows.Count
    Next I

    Set r = Selection
    n = r.Areas.Count
    For I = 1 To n
      rwCt2 = rwCt2 + r.Areas(I).Rows.Count
    Next I

    Debug.Print n & " areas selected."
    Debug.Print rwCt2 & " rows selected."
    Debug.Print rwCt & " visible rows selected."
    Debug.Print (rwCt2 - rwCt) & " hidden rows selected."

    AantalZichtbareRows = rwCt
End Function

vba 旧函数改为 return 行计数 returns 1

vba legacy function to return row count returns 1 instead

vba

rows

areas