求助各位大佬：用VBA调整位置，使各列没有重复值。

仁声

电子表中共有3列，各列有30行，里面有的姓名出现三次，有的出现两次。想用VBA达到以下效果：
调整各人姓名位置（各人姓名所在的行不能变，仅改变所在列），使每列中各人的姓名不出现重复，即每一列中没有重复值。

ykcbf1100

就你这个数据，应该做不到行数不变的情况下同列不重复。你可以自行验证。

仁声

ykcbf1100 发表于 2024-7-31 11:00
就你这个数据，应该做不到行数不变的情况下同列不重复。你可以自行验证。

能呀，调整后的效果如图的右三列。

limonet

关键字：filter

limonet

Sub limonet()
    Dim Arr As Variant, Brr As Variant, Crr As Variant, Drr As Variant, i%, j%, Tmp$
    i = Range("A" & Rows.Count).End(xlUp).Row
    Arr = Application.Transpose(Range("A2:A" & i))
    Brr = Application.Transpose(Range("B2:B" & i))
    Crr = Application.Transpose(Range("C2:C" & i))
    Drr = Range("A2:C" & i)
    For j = i - 1 To 1 Step -1
        Tmp = Drr(j, 2)
        If UBound(Filter(Arr, Drr(j, 1))) > 0 Then
            If UBound(Filter(Brr, Drr(j, 2))) > 0 Then
                If UBound(Filter(Crr, Drr(j, 3))) > 0 Then
                    Drr(j, 2) = Drr(j, 1)
                    Brr(j) = Drr(j, 1)
                    Drr(j, 1) = Drr(j, 3)
                    Arr(j) = Drr(j, 3)
                    Drr(j, 3) = Tmp
                    Crr(j) = Tmp
                Else
                    Drr(j, 2) = Drr(j, 3)
                    Brr(j) = Drr(j, 3)
                    Drr(j, 3) = Drr(j, 1)
                    Crr(j) = Drr(j, 1)
                    Drr(j, 1) = Tmp
                    Arr(j) = Tmp
                End If
            End If
        End If
    Next j
    Range("D2").Resize(i - 1, 3) = Drr
End Sub

仁声

limonet 发表于 2024-7-31 14:33
关键字：filter

limonet 大佬，看你旁边的统计，以为达到了效果，用重复格式一看，同一列中还是有好多重复项。没有达到每一列中没有重复项的效果，红字的为重复了的。

limonet

抱歉，重新写。

limonet

抱歉，一直在尝试，还是没写出来。

jx928867128

你这个是做什么的用的

jx928867128

仁声 发表于 2024-7-31 12:21
能呀，调整后的效果如图的右三列。

你这个有解的结果是怎么来的，手工调的吗