Question

以下代码适用于标有 Walk INs

的工作表

Sub Find_Duplicatel()
Dim wrkSht As Worksheet 'The worksheet that you're lookin for duplicates in.
Dim rng As Range        'The range containing the duplicates.
Dim Col As Long         'The last column containing data +1

Set wrkSht = ThisWorkbook.Worksheets("Walk INs")

With wrkSht
    'Reference to whole data range.
    Set rng = .Range("A5:L2003")

    'If the sheet is blank an error will be thrown when trying to find the last column.
    'This code looks for the last column - you could just set Col to equal the last column number + 1.
    On Error Resume Next
        Col = 12
        Err.Clear
    On Error GoTo 0
    If Col = 0 Then Col = 0

    'Place a COUNTIF formula in the last column.
    rng.Offset(, Col).Columns(1).FormulaR1C1 = "=COUNTIF(" & rng.Columns(1).Address(ReferenceStyle:=xlR1C1) & ",RC" & rng.Column & ") & "" duplicates."""

    With rng
        'Add conditional formatting to first column in range: If the COUNTIF formula is showing >1 then highlight cell.
        With .Columns(1)
            'This formula is =VALUE(LEFT($M5,FIND(" ",$M5)-1))>1.
            'It returns only the number from the duplicate count and checks it is higher than 1.
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=VALUE(LEFT(" & rng.Offset(, Col).Cells(1).Address(RowAbsolute:=False) & ",FIND("" ""," & _
                rng.Offset(, Col).Cells(1).Address(RowAbsolute:=False) & ")-1))>1"
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            .FormatConditions(.FormatConditions.Count).Interior.Color = RGB(0, 100, 255)
        End With

        'Apply filter to your range.
        .AutoFilter
        .AutoFilter Field:=12, Criteria1:="Yes"
    End With
End With
End Sub`

但是，当我将 Walk INs 更改为 VOC_ASST 时，它会挂起.AutoFilter我不确定原因。你能告诉我发生了什么吗？如何解决它。除了表单标题之外，每件事都是相同的。

Answer 1

您可以添加一些代码来检查是否已有AutoFilter。

If .AutoFilterMode = False Then
    .AutoFilter
    .AutoFilter Field:=12, Criteria1:="Yes"
End If

Answer 2

我在 ENCODEDNA 网站上找到了以下代码＆amp;在为我的工作表修改它之后，它完全按照我的预期工作。

Sub FIND_DUPLICATE()

`Option Explicit

Dim myDataRng As Range
Dim cell As Range

' WE WILL SET THE RANGE (FIRST COLUMN).
Set myDataRng = Range("A1:A" & Cells(Rows.Count, "B").End(xlUp).Row)

For Each cell In myDataRng
    cell.Offset(0, 0).Font.Color = vbBlack          ' DEFAULT COLOR.

    ' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED RANGE OF DATA.
    If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," &    
    cell.Address & ")") > 1 Then
        cell.Offset(0, 0).Font.Color = vbRed        ' CHANGE FORE COLOR TO  
  RED.
    End If
Next cell

Set myDataRng = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
 End Sub`

感谢那些帮助过我的人。

找不到重复的宏

2 个答案: