VBA数组分配问题，请各位大佬试试看你们能不能解出来

yynrzwh

楼上翻译版

1. Sub test2()
   
2. Sheet1.Activate
   
3. n = .Cells(Rows.Count, 1).End(3).Row - 1
   
4. Range("a2").Resize(n, 3).Sort [b2], xlDescending
   
5. brr = Range("a2").Resize(n, 3)
   
6. 
   
7. '贪心算法
   
8. ReDim drr(1 To n, 1 To 3)
   
9. For i = 1 To n
   
10.     For j = 1 To brr(i, 3)
    
11.         r = getmingroud(drr, n)
    
12.         drr(r, 1) = drr(r, 1) + 1
    
13.         drr(r, 2) = IIf(drr(r, 2) = "", brr(i, 1), drr(r, 2) & "+" & brr(i, 1))
    
14.         drr(r, 3) = drr(r, 3) + brr(i, 2)
    
15.     Next
    
16. Next
    
17. 
    
18. Range("f2").Resize(n, 3) = drr
    
19. End Sub
    
20. Private Function getmingroud(res, n)
    
21. Dim m, r&
    
22. m = res(1, 3): r = 1
    
23. For i = 1 To n
    
24.     If res(i, 3) < m Then
    
25.         m = res(i, 3): r = i
    
26.     End If
    
27. Next
    
28. getmingroud = r
    
29. End Function
    

复制代码

zeng3915

yynrzwh 发表于 2025-12-20 11:51
楼上翻译版

非常感谢大佬的代码，很好用，你太厉害了！！！！