VBA循环嵌套If语句语法问题：实现文本查找与值填充需求

需求说明 #

遍历指定源区域（A区域）的每一行，查找特定文本（如"Salary"）：

• 找到目标文本时，复制其右侧相邻单元格的值，粘贴到目标区域（B区域）对应列的下一个空单元格
• 未找到目标文本时，在目标区域对应列的下一个空单元格填入"NULL"

现有错误代码（循环与If语法问题） #

Sub IF_Statement_test()

Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = Range("A1:B4")

For Each row In rng.Rows
 
If row.Cells.Find(What:="Salary") = True Then
  row.Cells.Find(What:="Salary").Offset(0, 1).Copy
  Range("A8").Find(What:="Salary").Offset(0, 1).Select
  If Not IsEmpty(ActiveCell) Then
   Range("A8:E8").End(xlToRight).Offset(0, 1).PasteSpecial
  Else
  If IsEmpty(ActiveCell) Then
   ActiveCell.PasteSpecial
  ElseIf row.Cells.Find(What:="Salary") = False Then
    Range("A8").Find(What:="Salary").Offset(0, 1).Select
  If Not IsEmpty(ActiveCell) Then
    Range("A8:E8").End(xlToRight).Offset(0, 1).Value = "NULL"
  ElseIf IsEmpty(ActiveCell) Then
   ActiveCell.Value = "NULL"
 End If

Application.CutCopyMode = False
Next
End Sub

另一版不满足需求的代码 #

Sub Loop_Testing()

Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = Range("A1:GX14")


For Each row In rng.Rows
  
  On Error Resume Next
    
    'Employee Code
    row.Cells.Find(What:="Code").Offset(0, 1).Copy
    Range("A28:A45").Find(What:="Employee Code", LookAt:=xlWhole).Offset(0, 1).Select
      If Not IsEmpty(ActiveCell) Then
       Range("A29:Q29").End(xlToRight).Offset(0, 1).PasteSpecial
       Else
       ActiveCell.PasteSpecial
       End If
    
    
    'ID Number
    row.Cells.Find(What:="Number").Offset(0, 1).Copy
    Range("A28:A45").Find(What:="ID Number", LookAt:=xlWhole).Offset(0, 1).Select
    If Not IsEmpty(ActiveCell) Then
     Range("A31:Q31").End(xlToRight).Offset(0, 1).PasteSpecial
     ActiveCell.NumberFormat = "0"
     Else
     ActiveCell.PasteSpecial
     ActiveCell.NumberFormat = "0"
     End If

On Error GoTo 0

Next row

Application.CutCopyMode = False

End Sub

修正后的代码与说明 #

核心修正点 #

1. 避免重复调用Find，将查找结果存入变量，提升效率同时避免逻辑错误
2. 修正If语句嵌套结构，确保逻辑闭合
3. 弃用Select/ActiveCell，直接操作单元格对象，提升代码稳定性
4. 统一封装目标区域下一个空单元格的定位逻辑

单字段处理代码（以Salary为例） #

Sub ProcessSalaryData()
    Dim sourceRng As Range
    Dim targetHeaderCell As Range
    Dim currentRow As Range
    Dim foundCell As Range
    Dim targetNextEmptyCell As Range
    
    ' 定义源数据区域（A区域）和目标表头单元格（B区域中"Salary"所在单元格）
    Set sourceRng = Range("A1:B4")
    Set targetHeaderCell = Range("A8:E8").Find(What:="Salary", LookAt:=xlWhole)
    
    ' 检查目标表头是否存在，不存在则终止程序
    If targetHeaderCell Is Nothing Then
        MsgBox "目标区域未找到""Salary""表头", vbExclamation
        Exit Sub
    End If
    
    ' 遍历源区域每一行
    For Each currentRow In sourceRng.Rows
        ' 在当前行精准查找"Salary"
        Set foundCell = currentRow.Cells.Find(What:="Salary", LookAt:=xlWhole)
        
        ' 定位目标列的下一个空单元格
        Set targetNextEmptyCell = targetHeaderCell.Offset(1).Resize(100, 1).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole)
        ' 如果列内所有单元格都非空，取最后一行的下一行
        If targetNextEmptyCell Is Nothing Then
            Set targetNextEmptyCell = targetHeaderCell.Offset(targetHeaderCell.Parent.Cells(targetHeaderCell.Parent.Rows.Count, targetHeaderCell.Column).End(xlUp).Row - targetHeaderCell.Row + 1)
        End If
        
        ' 根据查找结果赋值
        If Not foundCell Is Nothing Then
            targetNextEmptyCell.Value = foundCell.Offset(0, 1).Value
        Else
            targetNextEmptyCell.Value = "NULL"
        End If
    Next currentRow
    
    Application.CutCopyMode = False
End Sub

多字段通用版本（适配Employee Code/ID Number等） #

如果需要批量处理多个字段，可封装通用函数避免重复代码：

Sub ProcessMultipleFields()
    Dim sourceRng As Range
    Dim targetHeaderRange As Range
    Dim fieldMappings As Variant
    Dim i As Integer
    Dim currentRow As Range
    
    ' 定义源数据区域和目标表头所在区域
    Set sourceRng = Range("A1:GX14")
    Set targetHeaderRange = Range("A28:A45")
    
    ' 定义字段映射：源查找文本 -> 目标表头文本
    fieldMappings = Array( _
        Array("Code", "Employee Code"), _
        Array("Number", "ID Number") _
    )
    
    ' 遍历源区域每一行
    For Each currentRow In sourceRng.Rows
        ' 遍历每个字段，调用通用处理函数
        For i = LBound(fieldMappings) To UBound(fieldMappings)
            ProcessSingleField currentRow, fieldMappings(i)(0), targetHeaderRange, fieldMappings(i)(1)
        Next i
    Next currentRow
    
    Application.CutCopyMode = False
End Sub

' 通用处理单个字段的函数
Sub ProcessSingleField(sourceRow As Range, sourceFindText As String, targetHeaderRange As Range, targetHeaderText As String)
    Dim foundCell As Range
    Dim targetHeaderCell As Range
    Dim targetNextEmptyCell As Range
    
    ' 在源行中查找目标文本
    Set foundCell = sourceRow.Cells.Find(What:=sourceFindText, LookAt:=xlWhole)
    
    ' 查找目标表头，不存在则直接退出
    Set targetHeaderCell = targetHeaderRange.Find(What:=targetHeaderText, LookAt:=xlWhole)
    If targetHeaderCell Is Nothing Then Exit Sub
    
    ' 定位目标列下一个空单元格
    Set targetNextEmptyCell = targetHeaderCell.Offset(1).Resize(100, 1).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole)
    If targetNextEmptyCell Is Nothing Then
        Set targetNextEmptyCell = targetHeaderCell.Offset(targetHeaderCell.Parent.Cells(targetHeaderCell.Parent.Rows.Count, targetHeaderCell.Column).End(xlUp).Row - targetHeaderCell.Row + 1)
    End If
    
    ' 根据查找结果赋值或设置为NULL
    If Not foundCell Is Nothing Then
        targetNextEmptyCell.Value = foundCell.Offset(0, 1).Value
        ' 针对ID Number设置纯数字格式
        If targetHeaderText = "ID Number" Then
            targetNextEmptyCell.NumberFormat = "0"
        End If
    Else
        targetNextEmptyCell.Value = "NULL"
    End If
End Sub

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