Excel VBA需求：识别重复Hash对应不同Coding并导出整行

操作步骤 #

• 打开目标Excel文件，按下快捷键 Alt + F11 打开VBA编辑器
• 在编辑器左侧「工程资源管理器」面板中，右键点击你的工作簿名称，选择「插入」→「模块」
• 将下方完整代码粘贴到右侧弹出的代码窗口中
• 按下 F5 或点击工具栏的绿色运行按钮执行代码

定制说明（修改这两处适配你的表头） #

代码里有两个变量需要你根据实际需求修改：

' 替换为你用来判断重复值的表头（示例为Hash）
Dim targetHeader1 As String: targetHeader1 = "Hash"
' 替换为你要对比内容的表头（示例为Coding）
Dim targetHeader2 As String: targetHeader2 = "Coding"

完整VBA代码 #

Sub ExtractCodingErrors()
    Dim wsSource As Worksheet
    Dim wsError As Worksheet
    Dim lastRow As Long
    Dim col1 As Integer, col2 As Integer
    Dim i As Long, j As Long
    Dim currentKey As String
    Dim compareValue As String
    Dim isDuplicateError As Boolean
    
    ' 设定源表为当前激活工作表
    Set wsSource = ActiveSheet
    
    ' 定位两个目标表头所在列
    col1 = wsSource.Rows(1).Find(What:=targetHeader1, LookIn:=xlValues, LookAt:=xlWhole).Column
    col2 = wsSource.Rows(1).Find(What:=targetHeader2, LookIn:=xlValues, LookAt:=xlWhole).Column
    
    ' 检查并创建「Coding Error」工作表
    On Error Resume Next
    Set wsError = ThisWorkbook.Worksheets("Coding Error")
    If Err.Number <> 0 Then
        Set wsError = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsError.Name = "Coding Error"
        ' 复制源表表头到错误表
        wsSource.Rows(1).Copy Destination:=wsError.Rows(1)
    Else
        ' 清空错误表原有数据（保留表头）
        wsError.Rows("2:" & wsError.Cells(wsError.Rows.Count, "A").End(xlUp).Row).ClearContents
    End If
    On Error GoTo 0
    
    lastRow = wsSource.Cells(wsSource.Rows.Count, col1).End(xlUp).Row
    
    ' 遍历源表数据行
    i = 2
    Do While i <= lastRow
        currentKey = wsSource.Cells(i, col1).Value
        compareValue = wsSource.Cells(i, col2).Value
        isDuplicateError = False
        
        ' 查找当前重复值的所有连续行
        j = i + 1
        Do While j <= lastRow And wsSource.Cells(j, col1).Value = currentKey
            If wsSource.Cells(j, col2).Value <> compareValue Then
                isDuplicateError = True
                Exit Do
            End If
            j = j + 1
        Loop
        
        ' 若存在内容不一致，复制对应行到错误表
        If isDuplicateError Then
            wsSource.Rows(i & ":" & j - 1).Copy Destination:=wsError.Cells(wsError.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
        
        i = j
    Loop
    
    MsgBox "错误行提取完成，结果已保存到「Coding Error」工作表", vbInformation
End Sub

注意事项 #

• 确保数据第一行是表头，且无合并单元格
• 若「Coding Error」工作表已存在，代码会清空原有数据（保留表头）后写入新结果
• 运行前建议先保存Excel文件，避免意外数据丢失

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