错误处理程序第一次运行,然后在第二个错误上给出超出范围的下标 [英] Error handler works first time then gives subscript out of range on the second error
问题描述
我有一个工作表,列出了各种统计数据的城市和属性类型。我正在尝试将每个属性类型的统计信息复制到一个单独的以城市命名的工作表。有些城市没有工作表,应该被忽略。我的代码确实忽略了第一个
实例,但是在第二个错误中给出了''下标超出范围'。
I have a worksheet that lists cities and property types with various statistics. I'm trying to copy each property type's statistics to a separate city-named worksheet. Some cities do not have worksheets and should be ignored. My code does ignore the first instance, but gives my 'subscript out of range' on the second error.
在我的白发脱落之前,我们将非常感谢任何帮助!
Any help would be greatly appreciated before my gray hair falls out!
以下是代码:
选项显式
Public Sub mUpdateCities()
表格("城市")。选择
范围("D2")。选择
Dim PropType As Variant
对于范围内的每个PropType("a2:a140"")
如果PropType ="CT",然后是
致电CopyCT
结束如果
如果PropType ="SFR",然后是
致电copySFR
结束如果
下一个
结束子
公共子副本SGR()
Dim Cell As范围
对于范围内的每个单元格("c2:c140")
City = Cell.Value
表格("城市") 。选择
ActiveCell.Resize(Columnsize:= 9)。选择
Selection.Copy
表格(城市)。选择
错误GoTo ErrorHandler
Application.Goto参考:=" R86C1"
Selection.End(xlDown) 。选择
ActiveCell.Offset(1,0)。选择
Selection.PasteSpecial粘贴:= xlPasteValues
ActiveCell.Offset(-1,9).Range(" A1")。选择
范围(选择,选择。结束(xlToRight))。选择
Selection.Copy
ActiveCell.Offset(1,0)。选择
ActiveSheet.Paste
ErrorHandler:
表格("城市")。选择
ActiveCell.Offset(1,0)。选择
下一个
退出Sub
End Sub
Sub CopyCT( )
$
出错时GoTo ErrorHandler
Dim Cell As Range
对于范围内的每个单元格("c2:c140")
City = Cell.Value
表格("城市")。选择
ActiveCell.Resize(Columnsize:= 8)。选择
Selection.Copy
表格(城市)。选择
Application.Goto参考:=" R88C23"
Selection.End(xlDown)。选择
   ActiveCell.Offset(1,0)。选择
Selection.PasteSpecial粘贴:= xlPasteValues
ActiveCell.Offset(-1,8).Range(" A1")。选择
范围(选择,选择。结束(xlToRight))。选择
Selection.Copy
ActiveCell.Offset(1,0)。选择
ActiveSheet.Paste
ErrorHandler:
表格("城市")。选择
ActiveCell.Offset(1,0)。选择
下一个
退出Sub
End Sub
TIA
Option Explicit
Public Sub mUpdateCities()
Sheets("Cities").Select
Range("D2").Select
Dim PropType As Variant
For Each PropType In Range("a2:a140")
If PropType = "CT" Then
Call CopyCT
End If
If PropType = "SFR" Then
Call copySFR
End If
Next
End Sub
Public Sub copySFR()
Dim Cell As Range
For Each Cell In Range("c2:c140")
City = Cell.Value
Sheets("Cities").Select
ActiveCell.Resize(Columnsize:=9).Select
Selection.Copy
Sheets(City).Select
On Error GoTo ErrorHandler
Application.Goto Reference:="R86C1"
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(-1, 9).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ErrorHandler:
Sheets("Cities").Select
ActiveCell.Offset(1, 0).Select
Next
Exit Sub
End Sub
Sub CopyCT()
On Error GoTo ErrorHandler
Dim Cell As Range
For Each Cell In Range("c2:c140")
City = Cell.Value
Sheets("Cities").Select
ActiveCell.Resize(Columnsize:=8).Select
Selection.Copy
Sheets(City).Select
Application.Goto Reference:="R88C23"
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(-1, 8).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ErrorHandler:
Sheets("Cities").Select
ActiveCell.Offset(1, 0).Select
Next
Exit Sub
End Sub
TIA
Rick
推荐答案
Hello Rick,
Hello Rick,
您的错误处理例程应捕获错误并路由到正确的位置以继续编程。例如,如果您的错误发生在
表格(城市)。选择,您可以尝试这种方法(我没有测试它,只是给你一个想法):
Your error handling routine shall capture an error and route to the proper place to continue program. For example, if your error happens at Sheets(City).Select, you can try this approach(I did not test it, just giving you an idea):
Sub CopyCT()
On Error GoTo ErrorHandler
Sub CopyCT()
On Error GoTo ErrorHandler
Dim bOK as Boolean
Dim Cell As Range
对于范围内的每个单元格("c2:c140")
Dim bOK as Boolean
Dim Cell As Range
For Each Cell In Range("c2:c140")
bOK =正确
City = Cell.Value
表格("城市")。选择
ActiveCell.Resize(Columnsize:= 8)。选择
Selection.Copy
表(市)。选择      
bOK=True
City = Cell.Value
Sheets("Cities").Select
ActiveCell.Resize(Columnsize:=8).Select
Selection.Copy
Sheets(City).Select
如果bOK = False则
表格("城市")。选择
ActiveCell.Offset(1,0)。选择
Sheets("Cities").Select
ActiveCell.Offset(1, 0).Select
" 或者您可能只想转到下一个小区:GoTo NextRec
endif
Application.Goto参考:=" R88C23"
Selection.End(xlDown)。选择
ActiveCell.Offset(1,0)。选择
Selection.PasteSpecial粘贴:= xlPasteValues
ActiveCell.Offset(-1,8).Range(" A1")。选择
范围(选择,选择。结束(xlToRight))。选择
Selection.Copy
ActiveCell.Offset(1,0)。选择
ActiveSheet.Paste
Application.Goto Reference:="R88C23"
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(-1, 8).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
NextRec:
下一步
NextRec:
Next
退出子
错误处理程序:
如果Err.Number = xx则 '(找到号码)
bOK =错误
接下来继续
结束如果
End Sub
End If
End Sub
这篇关于错误处理程序第一次运行,然后在第二个错误上给出超出范围的下标的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!