返回行计数的vba遗留函数返回1而不是

时间:2018-04-03 12:31:39

标签: vba rows areas

我正在使用一些遗留代码,我希望能够在此基础上进行构建,我似乎无法弄清楚以下内容:为什么函数AantalZichtbareRows会返回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

1 个答案:

答案 0 :(得分:1)

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

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

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

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