删除一行中相同名字所在列

砒霜里面放糖吃

求助求助，根据A行，如果名称重复则删除重复的那一列

ione_fox

Sub test()
Dim Ar()
Dim I&, Dic, K&
    Sheet1.Range("J1").CurrentRegion.Cells.ClearContents
    Ar = Sheet1.Range("a1").CurrentRegion
    Set Dic = CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(Ar, 2)
        If Dic(Ar(1, I)) = "" Then
        K = K + 1
            Dic(Ar(1, I)) = K
        Cells(1, 9 + K).Resize(UBound(Ar), 1) = Application.Index(Ar, 0, I)
        End If
    Next I
End Sub

砒霜里面放糖吃

别沉了啊 求助

败不馁

是第一行吧，直接输公式吧=COUNTIF($A$1:A1,A1)，大于1的列都删除！

砒霜里面放糖吃

ione_fox 发表于 2019-1-19 11:11
Sub test()
Dim Ar()
Dim I&, Dic, K&

大哥，可以直接将重复的列删除不呢？不用在后面显示结果。

砒霜里面放糖吃

败不馁 发表于 2019-1-19 11:41
是第一行吧，直接输公式吧=COUNTIF($A$1:A1,A1)，大于1的列都删除！

一行中有很多行，需要把名称重复的列都删除。

砒霜里面放糖吃

ione_fox 发表于 2019-1-19 11:11
Sub test()
Dim Ar()
Dim I&, Dic, K&

不用列示在后面，直接遍历A行的名称，删除重复名称的列就好了。。多谢多谢 真的很急

powerremain

a列排序，数据删除重复项

ione_fox

Sub test()
Dim Ar()
Dim I&, Dic, K&
    Sheet1.Range("J1").CurrentRegion.Cells.ClearContents
    Ar = Sheet1.Range("a1").CurrentRegion
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 0
    For I = 1 To UBound(Ar, 2)
        If Dic(Ar(1, I)) = "" Then
        K = K + 1
            Dic(Ar(1, I)) = K
        Else
            Columns(I).Delete
        End If
    Next I
End Sub

砒霜里面放糖吃

ione_fox 发表于 2019-1-19 19:09
Sub test()
Dim Ar()
Dim I&, Dic, K&

我多放了两列数据然后说，类型不匹配