【案例】匹配户主的身份证

Sub 查找户主信息()
    Dim i As Long, j As Long, 被查找值的行号 As Long
    Dim 查找的名字 As String, 匹配的户主身份证 As String, 匹配的户主关系 As String
    Dim 被查找值 As Variant
    Dim 被查找表格 As Workbook
    Dim target As Range, movetarget As Range
    
    Application.ScreenUpdating = False  ' 关闭屏幕更新，提高性能
    Application.DisplayAlerts = False   ' 关闭警告信息
    
    On Error GoTo ErrorHandler          ' 错误处理
    
    ' 打开被查找的工作簿
    Set 被查找表格 = Workbooks.Open("C:\Users\Administrator\Desktop\source.xlsx")
    
    ' 主循环
    For i = 1 To 8130
        ' 获取当前行的查找名字
        查找的名字 = ThisWorkbook.Sheets(1).Range("D" & i).Value
        
        ' 如果名字为空则跳过当前循环
        If 查找的名字 = "" Then
            GoTo NextIteration
        End If
        
        ' 重置匹配信息
        匹配的户主身份证 = ""
        匹配的户主关系 = ""
        
        ' 在被查找表格中查找名字
        For j = 1 To 488
            被查找值 = 被查找表格.Sheets("merge").Range("B" & j).Value
            
            ' 如果找到匹配的名字
            If 被查找值 = 查找的名字 Then
                被查找值的行号 = j  ' 记录匹配行号
                
                ' 检查当前行是否为户主
                If 被查找表格.Sheets("merge").Range("C" & 被查找值的行号).Value = "户主" Then
                    匹配的户主身份证 = 被查找表格.Sheets("merge").Range("E" & 被查找值的行号).Value
                    匹配的户主关系 = "户主"
                Else
                    ' 向上查找户主
                    Set target = 被查找表格.Sheets("merge").Range("C" & 被查找值的行号)
                    Do While Not target Is Nothing And target.Row > 1
                        Set movetarget = target.Offset(-1, 0)
                        
                        If movetarget.Value = "户主" Then
                            匹配的户主身份证 = 被查找表格.Sheets("merge").Range("E" & movetarget.Row).Value
                            匹配的户主关系 = target.Value
                            Exit Do
                        End If
                        
                        Set target = movetarget  ' 移动到上一行
                    Loop
                End If
                
                ' 将匹配结果写回当前工作簿
                ThisWorkbook.Sheets(1).Range("I" & i).Value = 匹配的户主身份证
                ThisWorkbook.Sheets(1).Range("J" & i).Value = 匹配的户主关系
                
                ' 找到后跳出内层循环，继续下一个名字
                Exit For
            End If
        Next j
        
NextIteration:
    Next i
    
    ' 清理资源
    被查找表格.Close SaveChanges:=False
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "处理完成！", vbInformation
    Exit Sub
    
ErrorHandler:
    ' 错误处理代码
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    ' 确保关闭已打开的工作簿
    On Error Resume Next
    If Not 被查找表格 Is Nothing Then
        被查找表格.Close SaveChanges:=False
    End If
    
    MsgBox "发生错误: " & Err.Description, vbCritical
    Exit Sub
End Sub