[已解决]求助一个代码

走进EXCEL · 发表于 2010-1-25 15:54

向各位老师求助一个代码,谢谢了先!!!!,

wf3xBelR.rar (2.3 KB, 下载次数: 0)

喜多多 · 发表于 2010-1-25 16:00

看不懂规则

[em06]

FookYou · 发表于 2010-1-25 17:08

Sub 排序()
Dim Arr, Ay, By, cR_n&, i&, j%, x%, y%, k%, S$, N%
Dim Dic As New Dictionary
    cR_n = [c65536].End(xlUp).Row
    Arr = Range("C3:G" & cR_n)
    For i = 1 To UBound(Arr)
      S = ""
      Ay = Application.Index(Arr, i)
      For j = 1 To UBound(Ay)
        If InStr(S, Ay(j)) = 0 Then
          S = S & "+" & Ay(j)
        End If
      Next
      By = Split(Right(S, Len(S) - 1), "+")
      k = UBound(By) - 1
      For x = 0 To k
        For y = 0 To k - x
          If By(y) > By(y + 1) Then
            N = By(y)
            By(y) = By(y + 1)
            By(y + 1) = N
          End If
        Next
      Next
      Dic(Join(By, "")) = i
    Next
    Range("P:P").ClearContents
    [P3].Resize(Dic.Count, 1) = Application.Transpose(Dic.Keys)
    Range("P3:P" & [p65536].End(xlUp).Row).Sort Key1:=Range("P3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin, DataOption1:=xlSortNormal
End Sub

FookYou · 发表于 2010-1-25 17:12

这个最佳答案由 FookYou 给出，感谢 FookYou 的回答。

单击隐藏图章

1DWogqdz.rar (9.17 KB, 下载次数: 10)

		自动登录	找回密码
密码			注册