刪除給定行中的重複條目

Question

我想要刪除每行中的重複項，以避免行中出現「漏洞」。我擁有的是：

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

確保列源數據的右邊是空白。輸出將會去那裏。

將這個程序在一個標準的代碼模塊並運行它：

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 

Answer 2

我建議迭代過的範圍內的每一行，提取所述值，生成所述唯一的一組，和repaste進行。

以下函數使用一個值數組並返回數組中的唯一值，使用Scripting.Dictionary。將參考（工具 - >參考文件...）添加到Microsoft腳本運行時。

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