Question

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

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

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

2 个答案: