删除给定行中的重复条目答案

【问题标题】：Delete duplicate entries in a given row删除给定行中的重复条目
【发布时间】：2015-11-24 12:10:31
【问题描述】：

我想删除每行中的重复项，这样行中就不应该有“洞”。我所拥有的是：

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

【问题讨论】：

标签： vba excel duplicates row

【解决方案1】：

我建议遍历范围内的每一行，提取值，生成唯一集，然后重新粘贴到行中。

以下函数采用一个值数组并使用Scripting.Dictionary 返回数组中的唯一值。添加对 Microsoft Scripting Runtime 的引用（Tools -> References...）。

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

【讨论】：

嘿，抱歉，我在 VBA 中的进步还不是刚刚开始，您可以在下面的表格中实现它吗？ dropbox.com/s/z6lga80zz7blutl/Pivot1.xlsm?dl=0
@Santosh 然后阅读 VBA。我强烈建议您首先阅读 vba、excel 和 excel-vba 的 wiki，然后通过各种链接进行操作。
@Santosh 如果你只能花时间做一个链接，this 应该是它，

【解决方案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

【讨论】：