迭代过去期望的停止点引起的VBA错误

背景：我试图将在工作中pipe理部门，设施和工作职位的旧风格转换为新的更方便的查找表风格格式。 现在，新部门，设施和职位的每组数据都存储在单独的工作表（每周几个）中，工作表名称是date。

问题：该程序运行良好的大部分工作簿; 不过，我最终得到了一个

1004 – 应用程序定义的或反对定义的错误

debugging时，我发现我的行值已经达到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 

一个侧面的问题：是否有一个更优雅的方式跳跃到for循环的下一个迭代而不使用GoTo语句。 我的想法是，这些都是我的问题。

感谢您的帮助。

Answer 1

问题是，如果任何表单上的数据都以组标题结束，或者none结束，那么它将启动一个永久循环，将row加1，直到达到工作表不支持的行号。

你已经在For循环之外的循环，所以它不停止。

最好是testing相反的代码，而不是使用古代的Goto 。

用这个：

 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 

---

根据Scott Holtzman现在删除的答案编辑简化Select Case

输出提供的数据：