Question

我想删除每一行中的重复项，这样就不会有＃34;空洞＆＃34;在行中。我所拥有的是：

Col A    Col B   Col C    Col D    Col E   Col F   Col G
A         B        C        D        A       B       A
J         I        K        J        I       K       I
B         A        B        J        I       K       L

最多40k行需要输出：

Col A    Col B   Col C    Col D    Col E   Col F   Col G
A         B        C        D       
J         I        K        
B         A        J        I       K       L

Answer 1

我建议迭代范围中的每一行，提取值，生成唯一集，然后重新进入行。

以下函数接受一组值，并使用Scripting.Dictionary返回数组中的唯一值。向Microsoft Scripting Runtime添加引用（工具 - ＆gt;引用... ）。

Function Unique(values As Variant) As Variant()
    'Put all the values as keys into a dictionary
    Dim dict As New Scripting.Dictionary, val As Variant
    For Each val In values
        dict(val) = 1
    Next
    Unique = dict.Keys
End Function

然后您可以执行以下操作：

Dim rng As Range, row As Range
Set rng = ActiveSheet.UsedRange
For Each row In rng.Rows
    Dim values() As Variant 'We need this to extract the values from the range, and to avoid passing in the range itself
    values = row
    Dim newValues() As Variant
    newValues = Unique(values)
    ReDim Preserve newValues(UBound(values, 2)) 'without this, the array will be smaller than the row, and Excel will fill the unmatched cells with #N/A
    row = newValues
Next

Answer 2

确保源数据右侧的列为空。输出将去那里。

将此例程放在标准代码模块中并运行它：

Public Sub CullDistinct()
    Dim rSrc As Range, lRws&, lCls&, lOut&, sOut$, sMn1$, sRow1$
    Set rSrc = [a1].CurrentRegion
    sRow1 = rSrc.Resize(1).Address(0, 1)
    lRws = rSrc.Rows.Count
    lCls = rSrc.Columns.Count
    lOut = lCls + 2
    sOut = Split(Cells(, lOut).Address, "$")(1)
    sMn1 = Split(Cells(, lOut - 1).Address, "$")(1) & 1: sMn1 = sMn1 & ":" & sMn1
    With Range(sOut & 1)
        .FormulaArray = "=IFERROR(INDEX(" & sRow1 & ",MATCH(,COUNTIF($" & sMn1 & "," & sRow1 & "),)),"""")"
        .Copy .Offset(, 1).Resize(, lCls - 1)
        .Resize(, lCls).Copy .Offset(1).Resize(lRws - 1)
        With .Resize(lRws, lCls): .Value = .Value: End With
    End With
End Sub

删除给定行中的重复条目

2 个答案: