出错时转到循环外的特定行,然后在循环内继续



Excel视图

我正在尝试将文件夹移动到另一个文件夹(移动对象(。

我编程了一个On Error GoTo Error_Manager,以便在出现错误时打印单元格。

Sub copy_paste_folder()
Dim folder As Object
Dim origin As String
Dim destiny As String
Set folder = CreateObject("scripting.filesystemobject")
Dim start_range As Range
Set start_range = ActiveSheet.Range("B2")
start_range.Select
On Error GoTo ErrorManager:
'The loop begins, in the excel we will see origin and destiny route.
Do Until ActiveCell.Offset(0, 1).Value = ""
origin = ActiveCell.Value
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
destiny = ActiveCell.Value
ActiveCell.Offset(rowOffset:=1, columnOffset:=-1).Activate
folder.copyfolder origin, destiny
Loop
Exit Sub
'I want to print the cell in case of an error.
ErrorManager:  
If Err.Number = 76 Then
ActiveCell.Offset(rowOffset:=-1, columnOffset:=-1).Activate
ActiveCell.Interior.Color = VBA.RGB(255, 185, 185)
ActiveCell.Offset(rowOffset:=1, columnOffset:=1).Activate
End If
End Sub

发现错误后,它在start_range.Select中重新开始,而不是在循环中。发生错误后,它必须进入循环。

我预计行中会出现错误:"原点=活动单元格。值";。

如果我正确理解你的代码,那么B列中有起源数据,C列中有命运(目的地?(数据。如果你对代码进行注释,你可以看到你的偏移量有点混乱。


'The loop begins, in the excel we will see origin and destiny route.
Do Until ActiveCell.Offset(0, 1).Value = "" 'C2
origin = ActiveCell.Value 'B2
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate ' Activate C2
destiny = ActiveCell.Value
ActiveCell.Offset(rowOffset:=1, columnOffset:=-1).Activate 'Activate B3
folder.copyfolder origin, destiny
Loop

Exit Sub

'In case of error
ErrorManager: 'I want to print the cell in case of error.
If Err.Number = 76 Then
ActiveCell.Offset(rowOffset:=-1, columnOffset:=-1).Activate ' Activate A1
ActiveCell.Interior.Color = VBA.RGB(255, 185, 185)
ActiveCell.Offset(rowOffset:=1, columnOffset:=1).Activate ' Activate B2
End If

在VBA中,如果使用范围而不是Activecell,则生活会变得非常简单。尝试将"On Error"活动与其自身功能隔离也是很有帮助的。

我希望下面的代码更接近您试图实现的目标。


Option Explicit

Sub copy_paste_folder()

Const CurrentRow As Long = 0
Const NextCol As Long = 1

Dim origin As String
Dim destiny As String

Dim folder As Object
Set folder = CreateObject("scripting.filesystemobject")


' You can search for the first empty cell or just use an arbitrarly long range
' based on the offsets I'm assuming you have origin data in col B and destiny data in Col C
Dim start_range As Range
Set start_range = ActiveSheet.Range("B2:B<theend>")
' I'm also a for each loop rather moving by activating a cell in the next row
' to make it the current cell.
'
Dim myCell As Variant
For Each myCell In start_range.Cells

' The two lines below 'Cast' the variant myRange to the exact type we want to use.
' doing this cast means we get the advantage of intellisense when following myCurrentCell with a '.'
Dim myCurrentCell As Excel.Range
Set myCurrentCell = myCell

' presumably your are testing for "" to determine of the  cell is empty
If IsEmpty(myCurrentCell) Then

Exit For

' If there is no error then TryGetValue will be true and the value of myrange will be in origin.
ElseIf TryGetValue(myCurrentCell, origin) Then

destiny = myCurrentCell.Offset(CurrentRow, NextCol).Value
folder.copyfolder origin, destiny

Else ' if we get here there was an error
myCurrentCell.Interior.Color = VBA.RGB(255, 185, 185)

End If

Next
End Sub
' The try function return true if the value was obtained without an error
' false if there was an error.
Public Function TryGetValue(ByRef ipRange As Excel.Range, ByRef opValue As Variant) As Boolean
On Error Resume Next
opValue = ipRange.Value
TryGetValue = Err.Number = 0
End Function

由于我没有你的数据,我没有测试上面的代码,但它确实编译没有错误。

最新更新