循环扫描工作表的总行内容

Question

我无法解决以下情况：我有一个循环复制名为“the_collector”的工作表中的值。同时，所有复制的值都是已经存在的工作表名称。所以第一列中所有复制的值都是工作表名。让我们转向问题：在第二列中，我想知道工作表内容的长度。我试过这个循环：

1. Sub Knop1_Klikken()
2.  Sheets.Add.Name = "The_collector"
3.  Sheets("The_collector").Move after:=Sheets("Blad2")
4.  For Count = 1 To 25
5.    snames = Sheets("Blad2").Cells(Count, 1).Value
6.    Sheets("The_collector").Cells(1, 1).Value = "snames"
7.    Sheets("The_collector").Cells(Count, 1).Value = snames
8.    countlastuntillrows = Sheets(Sheets(snames)).Cells.SpecialCells(xlCellTypeLastCell).Row
9.    Sheets("The_collector").Cells(Count, 2).Value = countlastuntillrows
10.  Next Count 
11.End Sub

当然，当我离开第 8 行和第 9 行时，我会在工作表中获得工作表名称列表。到目前为止，一切都很好。当我添加这两行时，我什么也没得到。我认为第八行有问题：countlastuntillrows 变量。执行步骤检查时出现错误 13。它指向第八行，我认为它指的是Sheets(snames)。我查看了帮助，我得到了这个：http://msdn.microsoft.com/en-us/library/office/jj535012(v=office.15).aspx

---

IamDranger：此代码有效（countlastuntillrows = Sheets(snames).Cells.SpecialCells(xlCellTypeLastCell).Row）但我仍然收到错误 9：http://msdn.microsoft.com/en-us/library/office/jj543427(v=office.15).aspx 有关错误的更多详细信息： http://msdn.microsoft.com/en-us/library/office/gg264179(v=office.15).aspx

我通过运行以下代码得到此代码：

Sub Knop1_Klikken()
 Sheets.Add.Name = "The_collector"
 Sheets("The_collector").Move after:=Sheets("Blad2")

 For Count = 1 To 25
    snames = Sheets("Blad2").Cells(Count, 1).Value
    Sheets("The_collector").Cells(1, 1).Value = "snames"
    Sheets("The_collector").Cells(Count, 1).Value = snames
        validName = False
    For Each ws In Worksheets
        If ws.Name = snames Then
            validName = True
            Exit For
        End If
    Next ws
    If validName = False Then
        Debug.Print "Invalid worksheet Name " & snames
    End If

    countlastuntillrows = Sheets(snames).Cells.SpecialCells(xlCellTypeLastCell).Row

    'countlastuntillrows = Sheets(Sheets(snames)).Cells.SpecialCells(xlCellTypeLastCell).Row
    Sheets("The_collector").Cells(Count, 2).Value = countlastuntillrows
  Next Count

End Sub

Answer 1

这是一个下标超出范围的错误类型，这似乎表明工作表名称无效。只是为了尝试隔离问题，您可以尝试更换您的

countlastuntillrows = Sheets(snames).Cells.SpecialCells(xlCellTypeLastCell).Row

符合

    On Error Resume Next
    countlastuntillrows = Sheets(snames).Cells.SpecialCells(xlCellTypeLastCell).row

    If err.Number = 9 Then
        err.Clear
        Sheets(snames).Select
        If err.Number = 9 Then
            MsgBox "Subscript out of Range: " & snames
        End If
    End If
    On Error GoTo 0

然后运行你的宏并确认msgbox是否真的弹出任何消息？

编辑：我并不完全清楚这里的所有细节，但看看这段代码是否适合

Sub worksheetsInvetory()
    Dim wsCollector As Worksheet
    Dim ws As Worksheet
    Dim curCell As Range

    Set wsCollector = Worksheets.Add(after:=Sheets(Sheets.count))

    With wsCollector
        On Error GoTo ERREUR
        .Name = "The_collector"
        On Error GoTo 0
        .Range("A1").Value = "Worksheet name"
        .Range("B1").Value = "Worksheet last used row"
        Set curCell = .Range("A2")
    End With

    For Each ws In Worksheets
        curCell.Value = ws.Name
        curCell.Offset(0, 1).Value = ws.Cells.SpecialCells(xlCellTypeLastCell).row
        Set curCell = curCell.Offset(1, 0)
    Next ws

    Exit Sub

ERREUR:

    MsgBox "The_Collector worksheet already exists"

End Sub

Answer 2

我发现了我是如何得到所有这些错误的，因为列表中有空单元格。我解决了这个问题并想出了这个代码：

lastrow = Sheets("The_collector").Cells.SpecialCells(xlCellTypeLastCell).row

For rCount = 2 To lastrow
    If Not Sheets("The_collector").Cells(rCount, 1).Value = "" Then
     snames= Sheets("The_collector").Cells(rCount, 1).Value
     Sheets("The_collector").Cells(rCount, 2).Value = Sheets(snames).Cells.SpecialCells(xlCellTypeLastCell).row
    End If
Next rCount