嵌套For语句退出并继续

时间:2017-03-28 05:12:57

标签: excel vba excel-vba

我使用2表示语句,1表示嵌套在另一个语句中。我遇到的问题是,当我退出第二个语句并返回第一个语句时,我无法将第二个语句转到下一个单元格,而是继续重复。

例如:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r&, c&, cel As Range
Dim r3&, c3&, cel3 As Range
Dim ri As Range
Dim CurrentSheet As String
Dim CurrentCell As String

CurrentSheet = ActiveSheet.Name

Application.ScreenUpdating = False

ActiveCell.Offset(-1, 0).Select
CurrentCell = ActiveCell.Address    
r = ActiveCell.Row

For c = 26 To 31
    Sheets(CurrentSheet).Select

    Set cel = Cells(r, c)
    cel.Select
    Selection.Copy

    Cells(Target.Row, "B").Select
    Set ri = ActiveCell
    Sheets("Checklist").Select

    'For c2 = 1 To 31            
        Sheets("Checklist").Cells.Find(What:=ri.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select

        For c3 = 25 To 30
            Sheets("checklist").Select
            r3 = Selection.Row
            Set cel3 = Sheets("checklist").Cells(r3, c3)
            cel3.Select
            Selection.PasteSpecial xlPasteValues
            Sheets(CurrentSheet).Select
            'Range(CurrentCell).Select
            'ActiveCell.Offset(0, 1).Select
            'CurrentCell = ActiveCell.Address
            'Exit For
        Next                        
    'Next
Next

Range(CurrentCell).Select

Application.CutCopyMode = False
Application.ScreenUpdating = True   

End Sub

请记住,这不是我的实际代码,而是一个如何构建的示例。它不是循环遍历第5 - 9列,而是继续选择第5列。

基本上我要对代码进行的操作是在Sheet1上更改单元格时,我希望它循环遍历该行中的每个单元格(预定数量的列)并将单元格值复制到sheet2(清单用于代码)并粘贴在相应的单元格中。该代码还在sheet1上查找并找到一个标识符,以便在sheet2中找到正确的行。

以下是示例文件Checklist Example

的链接

2 个答案:

答案 0 :(得分:1)

可能是你之后

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim f As Range
    If Intersect(Target, Range("D3:I11")) Is Nothing Then Exit Sub '<--| exit if user changed any cell outside "assigments" ones

    With Worksheets("Checklist") '<--\ reference "Checklist" sheet
        Set f = .Columns(1).SpecialCells(xlCellTypeConstants).Find(What:=Cells(Target.Row, 2), LookIn:=xlValues, LookAt:=xlWhole) '<--| try finding "Emp #" from Assignments sheet changed cell row column B in referenced sheet ("i.e. "Checklist") column "A" cells not blank cells
        If f Is Nothing Then '<--| if "Emp #" match not found
            MsgBox "I couldn't find " & Cells(Target.Row, 2).Value & " in worksheet 'Checklist'"
        Else ' <-- if "Emp #" match found
            .Range("AA:AF").Rows(f.Row).Value = Range("AA:AF").Rows(Target.Row).Value '<--| paste "Assigmnents" sheet changed cell row columns "AA:AF" content in corresponiding columns of referenced sheet ("i.e. "Checklist") row where "Emp #" match was found
        End If
    End With
End Sub

答案 1 :(得分:0)

我认为您正在使用下面较短的代码版本:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cel As Range
Dim ri As Range
Dim FndRng As Range

Application.ScreenUpdating = False

Set Cel = Range(Cells(Target.Row, 26), Cells(Target.Row, 31))

Set ri = Cells(Target.Row, "B")
Set FndRng = Sheets("Checklist").Cells.Find(What:=ri.value, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole)

If Not FndRng Is Nothing Then '<-- find was successful
    Cel.Copy
    FndRng.Offset(, 25 - FndRng.Column).PasteSpecial xlPasteValues
Else ' <-- if Find failed raise an error message box
    MsgBox "Unable to find " & ri.value & " in Sheet 'Checklist'"
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub