vba求助排序。

excelstudyvba

microyip 发表于 2022-5-6 18:08
用字典记录H列对应G列的值，然后对关键字进行排序，就得到对应的G列数

期待老师出手，字典的方法。

cui26896

审核中，请参考附件
求助排序.zip (13.56 KB, 下载次数: 8)

2022-5-6 19:41 上传

点击文件名下载附件

时间的音符

1. Private Function sort(nums, datas)
   
2.     For i = LBound(nums) To UBound(nums) - 1
   
3.         For j = i + 1 To UBound(nums)
   
4.             If IIf(nums(i) <> nums(j), nums(i) - nums(j), datas(j) - datas(i)) < 0 Then
   
5.                 tmp = nums(i): nums(i) = nums(j): nums(j) = tmp
   
6.                 tmp = datas(i): datas(i) = datas(j): datas(j) = tmp
   
7.             End If
   
8.         Next
   
9.     Next
   
10. End Function
    
11. 
    
12. Public Sub main()
    
13.     datas = Application.Transpose([g10:g19]): nums = Application.Transpose([h10:h19])
    
14.     Call sort(nums, datas)
    
15.     [h7] = "'" & Join(datas, "")
    
16. End Sub
    

复制代码

microyip

1. Sub 排序()
   
2.     Dim vData As Variant, vRow As Variant, vFill As Variant, nFill As Long, vKey As Variant, oDic As Object, nI As Long
   
3.    
   
4.     Set oDic = CreateObject("Scripting.Dictionary")
   
5.     vData = [G10:H19].Value
   
6.     For vRow = 1 To UBound(vData)
   
7.         vKey = vData(vRow, 2)
   
8.         If Not oDic.Exists(vKey) Then Set oDic(vKey) = CreateObject("Scripting.Dictionary")
   
9.         oDic(vKey)(vRow) = 0
   
10.     Next
    
11.     vKey = SortData(oDic.Keys())
    
12.     ReDim vFill(1 To UBound(vData), 1 To 2)
    
13.     For nI = LBound(vKey) To UBound(vKey)
    
14.         For Each vRow In oDic(vKey(nI)).Keys
    
15.             nFill = nFill + 1
    
16.             vFill(nFill, 2) = vData(vRow, 2)
    
17.             vFill(nFill, 1) = vData(vRow, 1)
    
18.         Next
    
19.     Next
    
20.     [J10].Resize(UBound(vFill), 2) = vFill
    
21. End Sub
    
22. 
    
23. Private Function SortData(ByVal vData As Variant) As Variant
    
24.     Dim nI As Double, nJ As Double, vTmp As Variant
    
25.    
    
26.     nJ = LBound(vData)
    
27.     For nI = LBound(vData) To UBound(vData) - 1
    
28.         If vData(nI) >= vData(nI + 1) Then
    
29.             If nI > nJ Then
    
30.                 nJ = nI
    
31.             Else
    
32.                 nI = nJ
    
33.             End If
    
34.         Else
    
35.             vTmp = vData(nI)
    
36.             vData(nI) = vData(nI + 1)
    
37.             vData(nI + 1) = vTmp
    
38.             If nI <> LBound(vData) Then nI = nI - 2
    
39.         End If
    
40.     Next nI
    
41.     SortData = vData
    
42. End Function

复制代码

microyip

附上附件以供参考

准提部林

表格的事, 交給表格功能處理//


Sub TEST()
Dim Arr, Brr, i&, T$
With Range("g10:h19")
     Arr = .Value
     .Sort Key1:=.Item(2), Order1:=xlDescending, Header:=xlNo
     Brr = .Value
     .Value = Arr
End With
For i = 1 To UBound(Brr)
    T = T & Brr(i, 1)
Next i
[g7] = "'" & T
End Sub

lizhipei78

准提部林 发表于 2022-5-6 22:09
表格的事, 交給表格功能處理//

我也是这样子想的，我原想着排序后，直接装字典，然后连起来，想不到你这个更简单

ykcbf1100

参与一下，工作表排序

ykcbf1100

1. Sub ykcbf()   '//2025.3.14
   
2.     r = Cells(Rows.Count, 7).End(3).Row
   
3.     Set Rng = Range("G10:H" & r)
   
4.     Rng.Sort Rng.Columns(2), 2
   
5.     arr = Application.Transpose(Range("g10:g" & r).Value)
   
6.     [g7] = Join(arr, "")
   
7. End Sub
   
8. 
   

复制代码

李贵濮

留个足迹。。。。。。。。