嵌套的 For 语句退出并继续



我用 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(代码目的的清单(并粘贴到相应的单元格中。该代码还会在工作表 1 上查找标识符,以查找工作表 2 中的正确行。

这是示例文件清单示例的链接

可能是

你在追求这个

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

我认为您追求的是下面较短的代码版本:

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

最新更新