Excel 用于重复行的VBA

我有一张专栏。 我想比较多列中的数据，并在另一列中返回一个标志，以指示重复的行。我在网上找到了一个用于检查一列数据的小代码，到目前为止，还不能成功地检查多列数据。最后的代码将需要查看我稍后将定义的特定列，但目前的工作表如下所示： 员工号码呼叫类型
1A
2b
1A
4d
5e
6f
7克
8小时
1A
2c
1 Z
6便士

Col A标有员工编号。列B被标记为CallType。在C列中，我希望针对行输入标志

我的代码如下：

次级问题（）

Dim last_StaffNumber尽可能长
将最后一个呼叫类型设置为“长”
调暗匹配\u工作人员编号，如长
Dim match_CallType尽可能长
调暗员工人数，如长
长的类型
last_StaffNumber=范围（“A65000”）。结束（xlUp）。行
最后调用类型=范围（“B65000”）。结束（xlUp）。行
对于StaffNumber=1到最后一个\u StaffNumber
对于CallType=1到last_CallType
'检查员工编号单元格是否有任何项目，如果为空则跳过。
如果单元格（StaffNumber，1）“，则
'正在获取单元格值的匹配索引号
match_StaffNumber=WorksheetFunction.match（单元格（StaffNumber，1），范围（“A1:A”&最后一个_StaffNumber），0）
如果单元格（CallType，2）“，则
match_CallType=WorksheetFunction.match（单元格（CallType，2），范围（“B1:B”和最后一个_CallType），0）
'如果匹配索引不等于当前行号，则它是重复值
如果StaffNumber匹配\u StaffNumber和CallType匹配\u CallType，则
'打印C列中的标签
单元格（StaffNumber，3）=“重复”
如果结束
如果结束
如果结束
下一个
下一个

端接头

我的问题是，只有当列1重复时，宏才会在列C中输入“duplicate”，并且它不会检查列B的值是否也相同。 任何帮助都将不胜感激。

请尝试以下代码：

选项显式
公共子行（）
Const SHEET_NAME As String=“Sheet1”
Const LAST_COL As Long=3'图例！！谢谢你，我只想问一个简单的问题。如果您有EntRecolumn.Delete'删除任何额外的列，我只需输入列，例如：EntRecolumn.Delete（4,5,6）要从比较中删除第4、5和6列，我很高兴这有帮助。对于“.entireclumn.Delete”-的行，该行删除最后一列之外的任何列和所有列。因此，如果您将最后一列设置为5，并且您的工作表总共有9个已用列，它将删除第6列到第9列。是否有任何方法指定要从比较中排除的选定列？假设我想比较第1列、第2列和第5列，但不是第3列和第4列？当然。但是，您可能需要考虑指定要包含的列——我假设您可能会有大约20列，并且您标识重复行的标准可能基于3到5。无论哪种方式，我都可以修改它，这样它将获取一个标题名（或列号）列表并将其全部排除，或者将列表中的标题名（或列号）包括在内并排除其余标题名（最好是较短的列表）
Dim last_StaffNumber As Long
Dim last_CallType As Long

Dim match_StaffNumber As Long
Dim match_CallType As Long

Dim StaffNumber As Long
Dim CallType As Long

last_StaffNumber = Range("A65000").End(xlUp).Row
last_CallType = Range("B65000").End(xlUp).Row

For StaffNumber = 1 To last_StaffNumber
For CallType = 1 To last_CallType

    'checking if the Staff Number cell is having any item, skipping if it is blank.
        If Cells(StaffNumber, 1) <> " " Then

        'getting match index number for the value of the cell
            match_StaffNumber = WorksheetFunction.Match(Cells(StaffNumber, 1), Range("A1:A" & last_StaffNumber), 0)

            If Cells(CallType, 2) <> " " Then

            match_CallType = WorksheetFunction.Match(Cells(CallType, 2), Range("B1:B" & last_CallType), 0)

                'if the match index is not equals to current row number, then it is a duplicate value
                If StaffNumber <> match_StaffNumber And CallType <> match_CallType Then
                    'Printing the label in the column C
                    Cells(StaffNumber, 3) = "Duplicate"
                End If
            End If
        End If
Next
Next

Option Explicit

Public Sub showDuplicateRows()
    Const SHEET_NAME    As String = "Sheet1"
    Const LAST_COL      As Long = 3 ' <<<<<<<<<<<<<<<<<< Update last column
    Const FIRST_ROW     As Long = 2
    Const FIRST_COL     As Long = 1
    Const DUPE          As String = "Duplicate"
    Const CASE_SENSITIVE As Byte = 1                    'Matches UPPER & lower

    Dim includedColumns As Object
    Set includedColumns = CreateObject("Scripting.Dictionary")
    With includedColumns
        .Add 1, ""  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 1 as dupe criteria
        .Add 3, ""  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 3 as dupe criteria
    End With
    Dim searchRng       As Range
    Dim memArr          As Variant
    Dim i               As Long
    Dim j               As Long
    Dim unique          As String
    Dim totalRows       As Long
    Dim totalCols       As Long
    Dim totalURCols     As Long
    Dim valDict         As Object
    Set valDict = CreateObject("Scripting.Dictionary")

    If CASE_SENSITIVE = 1 Then
        valDict.CompareMode = vbBinaryCompare
    Else
        valDict.CompareMode = vbTextCompare
    End If
    With ThisWorkbook.Sheets(SHEET_NAME)
        totalRows = .UsedRange.Rows.Count               'get last used row on sheet
        totalURCols = .UsedRange.Columns.Count          'get last used col on sheet
        Set searchRng = .Range( _
                                .Cells(FIRST_ROW, FIRST_COL), _
                                .Cells(totalRows, LAST_COL) _
                                )
        If LAST_COL < totalURCols Then
                        .Range( _
                                .Cells(FIRST_ROW, LAST_COL + 1), _
                                .Cells(FIRST_ROW, totalURCols) _
                                ).EntireColumn.Delete   'delete any extra columns
        End If
    End With

    memArr = searchRng.Resize(totalRows, LAST_COL + 1)  'entire range with data to mem

    For i = 1 To totalRows                              'each row, without the header
        For j = 1 To LAST_COL                           'each col
            If includedColumns.exists(j) Then
                unique = unique & searchRng(i, j)       'concatenate values on same row
            End If
        Next
        If valDict.exists(unique) Then                  'check if entire row exists
            memArr(i, LAST_COL + 1) = DUPE              'if it does, flag it in last col
        Else
            valDict.Add Key:=unique, Item:=i            'else add it to the dictionary
        End If
        unique = vbNullString
    Next
    searchRng.Resize(totalRows, LAST_COL + 1) = memArr  'entire memory back to the sheet
End Sub