去重复，对所有行按A列数字由小到大重新排序

771219

求助大大，谢谢谢谢

tzDel

=UNIQUE(SORT(A1:F416,1))

翁知江安

Sub test250509()
Dim i, j, m, jj As Integer, ar, br As Variant, d As Object, s As String
Set d = CreateObject("scripting.dictionary")
ar = [a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
[h1].Resize(UBound(ar), UBound(ar, 2)) = ar
[h1].Select
[h1].Resize(UBound(ar), UBound(ar, 2)).Sort key1:=Columns("h"), order1:=xlAscending, Header:=xlNo
ar = [h1].Resize(UBound(ar), UBound(ar, 2))
[h1].Resize(UBound(ar), UBound(ar, 2)).ClearContents
s = ""
For i = 1 To UBound(ar)
    For j = 1 To UBound(ar, 2)
       s = s & ar(i, j)
    Next
    If Not d.exists(s) Then
        d(s) = "": m = m + 1
        For jj = 1 To UBound(ar, 2)
            br(m, jj) = ar(i, jj)
        Next
    End If
    s = ""
Next
[h1].Resize(m, UBound(ar, 2)) = br
MsgBox "ok"
End Sub

翁知江安

供参考，欢迎批评指正

771219

tzDel 发表于 2025-5-9 22:06
=UNIQUE(SORT(A1:F416,1))

这个在2007版Excel提示无效

771219

翁知江安 发表于 2025-5-9 22:44
供参考，欢迎批评指正

谢谢大大，完美，嘻嘻

micch

现成的类

gwjkkkkk

Option Explicit
Sub test2()
    Dim ar, i&, j&, r&, dic As Object, strJoin$
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A1].CurrentRegion.Value
    bSort ar, 1, UBound(ar), 1, UBound(ar, 2), 1
    For i = 1 To UBound(ar)
        strJoin = Join(Application.Index(ar, i), "|")
        If Not dic.exists(strJoin) Then
            dic(strJoin) = Empty
            r = r + 1
            For j = 1 To UBound(ar, 2)
                ar(r, j) = ar(i, j)
            Next j
        End If
    Next i
   
    [H1].CurrentRegion.Clear
    [H1].Resize(r, UBound(ar, 2)) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

Function bSort(ByRef ar, ByVal iFirst&, ByVal iLast&, ByVal iLeft&, _
    ByVal iRight&, ByVal iKey&, Optional isOrder As Boolean = True)
    Dim i&, j&, k&, vTemp
   
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j, iKey) <> ar(j + 1, iKey) Then
                If ar(j, iKey) < ar(j + 1, iKey) Xor isOrder Then
                    For k = iLeft To iRight
                        vTemp = ar(j, k)
                        ar(j, k) = ar(j + 1, k)
                        ar(j + 1, k) = vTemp
                    Next
                End If
            End If
        Next j
    Next i
End Function

gwjkkkkk

ykcbf1100

参与一下。。。