帮助写一个自定义排序函数用VBA写

ghzhiyi

                        写一个自定义函数，以B3:K3中的值的大小应对0~9数字进行排序，并连带起来
  被排序的数据  0  1  2  3  4  5  6  7  8  9  结果  
  值  1.2  1.5  0.7  3.4  1.1  0.6  2  2.2  1.3  1  3761804925  
    50  76  10  51  22  14  80  21  22  34  6130948752  
                          
                          

3190496160

连个附件都懒得上传，还得帮你做个附件？？？？

ghzhiyi

传了，没有传上来，不好意思

ghzhiyi

写一个自定义排序函数.rar (6.91 KB, 下载次数: 7)

2020-1-28 10:31 上传

点击文件名下载附件

3190496160

点击按钮实现效果
Sub test()
Set d = CreateObject("scripting.dictionary")
With Sheet1
    ws = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("a2:l" & ws)
    For i = 2 To UBound(ar)
        k = ""
        n = 0
        ReDim br(1 To UBound(ar))
        For jj = 1 To 10
            For j = 2 To UBound(ar, 2) - 1
                m = Application.Large(Application.Index(ar, i, 0), jj)
                If ar(i, j) = m Then
                    n = n + 1
                    d(ar(1, j)) = ""
                End If
            Next j
        Next jj
        For Each ss In d.keys
            If k = "" Then
                 k = ss
            Else
               k = k & ss
            End If
        Next ss
        ar(i, 12) = k
        d.RemoveAll
    Next i
    .Range("a2:l" & ws) = ar
End With
End Sub

3190496160

Book1.zip (13.88 KB, 下载次数: 10)

2020-1-28 10:46 上传

点击文件名下载附件

ghzhiyi

帮我写一个自定义函数

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, brr, i As Long, j As Long, k As Long, t As String
  arr = [b2:k2].Value
  ReDim mark(1 To UBound(arr, 2)) As String
  For i = 1 To UBound(mark)
    mark(i) = arr(1, i)
  Next
  arr = Range("b3:k" & Cells(Rows.Count, "b").End(xlUp).Row).Value
  For i = 1 To UBound(arr, 1)
    brr = mark
    For j = 1 To UBound(arr, 2) - 1
      For k = 1 To UBound(arr, 2) - j
        If Val(arr(i, k)) < Val(arr(i, k + 1)) Then
          t = arr(i, k): arr(i, k) = arr(i, k + 1): arr(i, k + 1) = t
          t = brr(k): brr(k) = brr(k + 1): brr(k + 1) = t
        End If
      Next
    Next
    For j = 2 To UBound(brr)
      brr(1) = brr(1) & brr(j)
    Next
    arr(i, 1) = brr(1)
  Next
  [l3].Resize(UBound(arr, 1)) = arr
End Sub