arrays - 隐藏重复的单元格而不使用辅助列

Question

我需要隐藏某个范围内的重复单元格。
使用AdvancedFilter，它隐藏了重复的单元格，但它也阻止我进行后续的正常过滤。
我已经使用了 @FaneDure 先生提供的以下工作代码，但它取决于辅助列。
我寻求相同的结果，如果它可以在不使用辅助列的情况下实现。
是否可以将唯一单元格的地址放入数组中，然后使用该数组作为自动过滤的条件？
请注意，隐藏重复单元格后，我将手动执行后续的正常过滤器。
预先，非常感谢您抽出时间提供帮助。

Sub Hide_visible_duplicate_cells_(procRng As Range)
    Dim arng As Range, C As Range, dict As New Scripting.Dictionary
    Dim arrMark, colMark As Range, lastC As Long, sh As Worksheet, lastR As Long, i As Long
    
    Const markName As String = "Marker_column"
    
    Set arng = procRng.SpecialCells(xlCellTypeVisible)
    
    If arng Is Nothing Then MsgBox "Not a valid Range": Exit Sub
    
    Set sh = procRng.Parent 'the sheet where the range belongs to

    lastR = sh.UsedRange.rows(sh.UsedRange.rows.count).row  'last row OF THE SHEET
    ReDim arrMark(1 To lastR, 1 To 1) 'redim the markers array
    
    'determinte the column where the marker to be placed (or it already exists):
    Set colMark = sh.rows(procRng.cells(1).row).Find(What:=markName, LookIn:=xlValues, LookAt:=xlWhole)
    If Not colMark Is Nothing Then
        lastC = colMark.column  'for the case when the marker column exists
    Else
        lastC = sh.cells(procRng.cells(1).row, sh.Columns.count).End(xlToLeft).column + 1 'next empty column if marker column does not exist
        'to correct the last column number, IF LAST COLUMN IS HIDDEN (it MUST HAVE A HEADER):
        If sh.cells(procRng.cells(1).row, lastC).Value <> "" Then lastC = lastC + 1
    End If
    
    For Each C In arng.cells
        If Not dict.Exists(C.Value) Then
            If i > 0 Then                                            'to skip the first cell, which should be on the headers row
                dict.Add C.Value, vbNullString       'Keep the first occurrence
                arrMark(C.row - procRng.cells(1).row, 1) = "True"      'place the marker for the first occurrence
            End If
            If C.Value <> "" Then i = i + 1 'for the case of empty cells above the header...
        End If
    Next C
    'place the marker column header, if not already existing:
     If colMark Is Nothing Then sh.cells(procRng.cells(1).row, lastC).Value = markName 'place the marker column name, IF NOT EXISTS
     
    If sh.AutoFilterMode Then sh.AutoFilterMode = False  'eliminate the filter, if any
    
    'drop the markers array content:
    sh.cells(procRng.cells(1).row + 1, lastC).Resize(UBound(arrMark), 1).Value2 = arrMark
    
    'filter by the marker column
    sh.Range(sh.cells(procRng.cells(1).row, 1), sh.cells(sh.UsedRange.rows.count, lastC)).AutoFilter lastC, "True"
End Sub

Answer 1

请尝试下一个代码。它连接第一个找到的单元格内容，并添加一个不太可能在另一个单元格中找到的字符串。然后将它们作为项目放入使用的字典中。事实上，看看它和它的评论:

Sub Hide_visible_duplicate_c(procRng As Range)
    Dim arng As Range, C As Range, dict As New Scripting.Dictionary
    Const strStr As String = "###$$" 'something unusual, to  not be found in the other cells content
    
    Set arng = procRng.Offset(1).Resize(procRng.rows.count - 1).SpecialCells(xlCellTypeVisible) 'eliminating the header
    
    If arng Is Nothing Then MsgBox "Not a valid Range": Exit Sub
    
    Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False
     For Each C In arng.cells
        If Not dict.Exists(C.Value) Then
            dict.Add C.Value, C.Value & strStr       'Keep the first occurrence but miodified string item
            C.Value = dict(C.Value)                  'modify the first occurence cell content
        End If
     Next C

    procRng.CurrentRegion.AutoFilter procRng.column, dict.Items, xlFilterValues 'filter by the modified cells
    procRng.Replace strStr, "" 'replace the added unusual string
    
    Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
    
    MsgBox "Ready...", vbInformation, "Job done"
End Sub

可以通过以下方式进行测试:

Sub TestHide_visible_duplicate_cells()
    Dim sh As Worksheet, lastR As Long
    Const filtCol As Long = 2   'change here according to the need
    Const headerRow As Long = 2 'change it if necessary
    
    Set sh = ActiveSheet: lastR = sh.cells(sh.rows.count, filtCol).End(xlUp).row
    If Not sh.FilterMode Then MsgBox "This code needs a filtered range to be processed!", vbInformation, "End": Exit Sub
    
    Hide_visible_duplicate_c sh.Range(sh.cells(headerRow, filtCol), sh.cells(lastR, filtCol)) 'send the filtered column as argument
End Sub