如何用VBA Find函数判断Excel工作表中是否存在指定数据行

阿华AIGC实验室

2026-5-27

解决VBA中同时匹配两列数据进行查找的问题

你说得没错，Range.Find() 默认只能基于单个单元格的值进行查找——当你传入一个多单元格区域（比如Sheets("MAIN").Range("B5:C5").Offset(...)）时，它只会提取这个区域左上角单元格的值（也就是B列的日期）作为查找依据，这就导致了同日期不同员工的数据被错误覆盖的问题。

下面给你几种实用的解决思路，从易上手到高效优化分层次说明：

方法1：使用辅助列生成唯一标识（最易上手）

在LOG表新增一列（比如C列），将A列（日期）和B列（员工）拼接成一个唯一字符串（比如单元格公式=A2&B2），然后通过查找这个唯一标识来匹配整行：

Sub CopyToLog_WithHelperColumn()
    Dim mainWs As Worksheet, logWs As Worksheet
    Dim rowCount As Integer, lastLogRow As Long
    Dim matchValue As String, dupeRange As Range
    
    ' 先定义工作表变量，避免重复引用
    Set mainWs = ThisWorkbook.Sheets("MAIN")
    Set logWs = ThisWorkbook.Sheets("LOG")
    
    ' 自动创建辅助列表头（如果不存在）
    If logWs.Range("C1").Value <> "UniqueKey" Then
        logWs.Range("C1").Value = "UniqueKey"
    End If
    
    For rowCount = 1 To mainWs.Range("WeeklyData").Rows.Count
        ' 生成当前行的唯一匹配键（日期+员工）
        matchValue = mainWs.Range("B5").Offset(rowCount - 1, 0).Value & _
                     mainWs.Range("C5").Offset(rowCount - 1, 0).Value
        
        ' 在LOG表辅助列查找唯一键
        Set dupeRange = logWs.Range("C:C").Find(What:=matchValue, LookIn:=xlValues, LookAt:=xlWhole)
        
        ' 定义要复制的源数据区域
        Dim sourceRange As Range
        Set sourceRange = mainWs.Range("B5:F5").Offset(rowCount - 1, 0)
        
        If dupeRange Is Nothing Then
            ' 无匹配，粘贴到LOG表最后一行的下一行
            lastLogRow = logWs.Cells(logWs.Rows.Count, "A").End(xlUp).Row + 1
            sourceRange.Copy
            logWs.Cells(lastLogRow, "A").PasteSpecial Paste:=xlPasteValues
        Else
            ' 有匹配，覆盖对应行
            sourceRange.Copy
            logWs.Cells(dupeRange.Row, "A").PasteSpecial Paste:=xlPasteValues
        End If
    Next rowCount
    
    ' 清除剪贴板，避免弹窗干扰
    Application.CutCopyMode = False
End Sub

方法2：使用Find+FindNext匹配双条件（无需辅助列）

如果不想新增辅助列，可以先查找日期匹配的行，再逐个检查员工列是否匹配：

Sub CopyToLog_FindNext()
    Dim mainWs As Worksheet, logWs As Worksheet
    Dim rowCount As Integer, lastLogRow As Long
    Dim searchDate As Variant, searchEmployee As String
    Dim dupeRange As Range, firstMatchAddr As String
    Dim matchFound As Boolean
    
    Set mainWs = ThisWorkbook.Sheets("MAIN")
    Set logWs = ThisWorkbook.Sheets("LOG")
    
    For rowCount = 1 To mainWs.Range("WeeklyData").Rows.Count
        searchDate = mainWs.Range("B5").Offset(rowCount - 1, 0).Value
        searchEmployee = mainWs.Range("C5").Offset(rowCount - 1, 0).Value
        
        ' 先查找所有日期匹配的行
        Set dupeRange = logWs.Range("A:A").Find(What:=searchDate, LookIn:=xlValues, LookAt:=xlWhole)
        matchFound = False
        
        If Not dupeRange Is Nothing Then
            firstMatchAddr = dupeRange.Address
            ' 遍历日期匹配的行，检查员工列是否一致
            Do
                If logWs.Cells(dupeRange.Row, "B").Value = searchEmployee Then
                    matchFound = True
                    Exit Do
                End If
                Set dupeRange = logWs.Range("A:A").FindNext(dupeRange)
            Loop While Not dupeRange Is Nothing And dupeRange.Address <> firstMatchAddr
        End If
        
        Dim sourceRange As Range
        Set sourceRange = mainWs.Range("B5:F5").Offset(rowCount - 1, 0)
        
        If Not matchFound Then
            ' 无匹配，新增行
            lastLogRow = logWs.Cells(logWs.Rows.Count, "A").End(xlUp).Row + 1
            sourceRange.Copy
            logWs.Cells(lastLogRow, "A").PasteSpecial Paste:=xlPasteValues
        Else
            ' 有匹配，覆盖对应行
            sourceRange.Copy
            logWs.Cells(dupeRange.Row, "A").PasteSpecial Paste:=xlPasteValues
        End If
    Next rowCount
    
    Application.CutCopyMode = False
End Sub

方法3：使用字典（最高效，适合大数据量）

字典可以快速存储已有的（日期+员工）组合对应的行号，查找效率远高于循环查找，适合数据量较大的场景：

Sub CopyToLog_Dictionary()
    Dim mainWs As Worksheet, logWs As Worksheet
    Dim rowCount As Integer, logRow As Long
    Dim sourceData As Variant, logData As Variant
    Dim uniqueKey As String
    Dim dict As Object
    
    Set mainWs = ThisWorkbook.Sheets("MAIN")
    Set logWs = ThisWorkbook.Sheets("LOG")
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 读取LOG表现有数据，存入字典（键为日期+员工，值为行号）
    logRow = logWs.Cells(logWs.Rows.Count, "A").End(xlUp).Row
    If logRow >= 1 Then
        logData = logWs.Range("A1:B" & logRow).Value
        For i = 1 To UBound(logData)
            uniqueKey = logData(i, 1) & logData(i, 2)
            dict(uniqueKey) = i
        Next i
    End If
    
    ' 读取MAIN表待处理数据到数组，提升效率
    sourceData = mainWs.Range("B5:F" & mainWs.Range("WeeklyData").Rows.Count + 4).Value
    
    For rowCount = 1 To UBound(sourceData)
        uniqueKey = sourceData(rowCount, 1) & sourceData(rowCount, 2) ' B列日期+C列员工
        If dict.exists(uniqueKey) Then
            ' 存在匹配，覆盖对应行
            logWs.Cells(dict(uniqueKey), "A").Resize(1, 5).Value = _
                Array(sourceData(rowCount, 1), sourceData(rowCount, 2), sourceData(rowCount, 3), sourceData(rowCount, 4), sourceData(rowCount, 5))
        Else
            ' 不存在，新增到最后一行
            logRow = logRow + 1
            logWs.Cells(logRow, "A").Resize(1, 5).Value = _
                Array(sourceData(rowCount, 1), sourceData(rowCount, 2), sourceData(rowCount, 3), sourceData(rowCount, 4), sourceData(rowCount, 5))
            dict(uniqueKey) = logRow ' 更新字典
        End If
    Next rowCount
End Sub