删除给定行中的重复条目 [英] Delete duplicate entries in a given row

问题描述

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

I want to delete the duplicates in each row, such that there should be no "holes" in the row. What I have is:

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行。

输出需要：

up to 40k rows.
Output required:

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

推荐答案

确保列您的源数据的权利是空白的。输出将要去那里。

Make sure that the columns to the right of your source data are blank. The output is going to go there.

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

Place this routine in a standard code module and run it:

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

这篇关于删除给定行中的重复条目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！