请求为VBA For Each循环添加Else条件：实现匹配复制与无匹配添加排序

针对你的需求，我修改了原有代码，实现以下功能：

• 若N列单元格在Y列找到匹配项，将对应Z列值复制回该N列单元格
• 若未找到匹配项，将该N列值追加到Y列最后一行，最后对Y:Z列按字母顺序排序

修改后的完整代码：

Sub UpdateAndSortData()
    Dim DEST As Worksheet
    Dim DATA As Worksheet
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim c As Range
    Dim foundCell As Range
    Dim lastYRow As Long
    
    Set DEST = Sheets("Mil")
    Set DATA = Sheets("Scr")
    
    ' 定义Y列数据区域（从Y2开始到最后一行）
    Set Rng1 = DATA.Range("Y2:Y" & DATA.Cells(DATA.Rows.Count, "Y").End(xlUp).Row)
    ' 定义N列数据区域（从N2开始到最后一行）
    Set Rng2 = DATA.Range("N2:N" & DATA.Cells(DATA.Rows.Count, "N").End(xlUp).Row)
    
    For Each c In Rng2
        ' 在Y列查找当前N列单元格的值
        Set foundCell = Rng1.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not foundCell Is Nothing Then
            ' 找到匹配项，复制对应Z列值到当前N列单元格
            foundCell.Offset(0, 1).Copy Destination:=c
        Else
            ' 未找到匹配项，获取Y列最后一行行号
            lastYRow = DATA.Cells(DATA.Rows.Count, "Y").End(xlUp).Row + 1
            ' 将当前N列值写入Y列最后一行
            DATA.Cells(lastYRow, "Y").Value = c.Value
            ' 更新Y列数据区域（包含新添加的行）
            Set Rng1 = DATA.Range("Y2:Y" & lastYRow)
        End If
    Next c
    
    ' 对Y:Z列从Y2开始到最后一行按Y列升序排序
    lastYRow = DATA.Cells(DATA.Rows.Count, "Y").End(xlUp).Row
    DATA.Range("Y2:Z" & lastYRow).Sort _
        Key1:=DATA.Range("Y2"), Order1:=xlAscending, _
        Header:=xlNo, Orientation:=xlTopToBottom
End Sub

关键修改说明 #

• 新增foundCell变量存储查找结果，通过判断foundCell Is Nothing确认是否找到匹配，比单纯依赖错误捕获更直观可靠
• 未找到匹配时，自动定位Y列最后一行并追加值，同时更新Rng1确保后续查找包含新添加的内容
• 遍历完成后，调用Sort方法对Y:Z列按Y列字母顺序升序排序，排序范围自动适配最新数据行

内容的提问来源于stack exchange，提问作者FotoDJ