Question

背景我正在尝试将旧式的管理部门，设施和工作标题转换为更方便的查找表样式格式。现在，新部门，设施和职称的每组数据都存储在单独的工作表上（每周一对），工作表名称是日期。

问题： 该程序适用于大多数工作簿;但是，我最终得到了一个

1004 - 应用程序定义或对象定义的错误

调试时，我发现我的行值为1,048,577，因此导致错误。我不确定迭代值是如何逃避我对它的处理。

代码：

Sub cleanUp()

Dim wks As Worksheet
Dim wksNum As Long
Dim destWks As Worksheet
Dim rng As Range
Dim row As Long
Dim col As Long
Dim destRow As Long
Dim lastRow As Long
Dim itemType As String


Set destWks = ActiveWorkbook.Sheets("new")
destRow = 2

For wksNum = 1 To ActiveWorkbook.Sheets.Count
NextWks:
    Set wks = ActiveWorkbook.Worksheets(wksNum)

    If wks.Name = "new" Then
        wksNum = wksNum + 1
        GoTo NextWks
    End If

    lastRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).row

    For row = 1 To lastRow
NextRow:
            Select Case wks.Cells(row, 1).Value
                Case "New Hospitals"
                    itemType = "Hospital"
                    row = row + 1
                    GoTo NextRow
                Case "New Departments"
                    itemType = "Department"
                    row = row + 1
                    GoTo NextRow
                Case "New Job Titles"
                    itemType = "Job Title"
                    row = row + 1
                    GoTo NextRow
                Case "none"
                    row = row + 1
                    GoTo NextRow
                Case ""
                    row = row + 1
                    GoTo NextRow
            End Select
            destWks.Cells(destRow, 1).Value = wks.Name
            destWks.Cells(destRow, 2).Value = itemType
            wks.Range("A" & row & ":C" & row).Copy destWks.Range("C" & destRow)
            destRow = destRow + 1
    Next row

Next wksNum

End Sub

示例表：

New Hospitals   
None    

New Departments 
10 146 7205-DeptA
10 193 9178-DeptB   

New Job Titles  
004315  JobTitleA

一个问题： 有没有使用GoTo语句跳过到for循环的下一次迭代的更优雅的方法。我的想法是，这些都是导致我的问题。

感谢您的帮助。

Answer 1

问题是，如果您在任何工作表上的数据以组标题或none结尾，那么它将启动一个永久循环，将{1}添加1，直到它到达不支持的行号通过工作表。

你已经在For循环之外进行了循环，因此它不会停止。

最好测试相反的情况并执行代码而不是使用古老的row。

使用此：

Goto

根据Scott Holtzman现已删除的答案编辑简化Sub cleanUp() Dim wks As Worksheet Dim wksNum As Long Dim destWks As Worksheet Dim rng As Range Dim row As Long Dim col As Long Dim destRow As Long Dim lastRow As Long Dim itemType As String Set destWks = ActiveWorkbook.Sheets("new") destRow = 2 For wksNum = 1 To ActiveWorkbook.Sheets.Count Set wks = ActiveWorkbook.Worksheets(wksNum) If wks.Name <> "new" Then lastRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).row For row = 1 To lastRow Select Case wks.Cells(row, 1).Value Case "New Hospitals", "New Departments", "New Job Titles" itemType = Replace(wks.Cells(row, 1).Value, "New ", "") Case "None", "" Case Else destWks.Cells(destRow, 1).Value = wks.Name destWks.Cells(destRow, 2).Value = itemType wks.Range("A" & row & ":C" & row).Copy destWks.Range("C" & destRow) destRow = destRow + 1 End Select Next row End If Next wksNum End Sub

使用提供的数据输出：

迭代超过预期停止点引起的VBA错误

1 个答案: