VBA 数组排序

kaiwozhe · 发表于 2024-9-18 18:07

Qs18 发表于 2024-9-18 15:33
调整了一下.........

感谢帮助，不过可能是我没表达好，日期和每天应取的数量是需要按照我原表的，

比如是
1月1日需要2票
1月2日需要4票
1月3日需要7票

gwjkkkkk · 发表于 2024-9-18 18:43

Option Explicit
Sub TEST3()
Dim ar, br, cr, i&, j&, r&, n&, t#

Application.ScreenUpdating = False
t = Timer

ar = [A1].CurrentRegion.Value
br = [G1].CurrentRegion.Value
For i = 2 To UBound(br)
      ReDim cr(1 To UBound(ar), 1 To 1)
      r = 0: br(i, 3) = Empty
      For j = 2 To UBound(ar)
         If ar(j, 1) = br(i, 1) Then
            r = r + 1
            cr(r, 1) = ar(j, 2)
         End If
      Next j
      If r Then
         ShellSort2D cr, 1, r, 1, 1, 1, False
         If r > br(i, 2) Then n = br(i, 2) Else n = r
         For j = 1 To n
            br(i, 3) = br(i, 3) + cr(j, 1)
         Next j
      End If
Next i

[G1].Resize(UBound(br), UBound(br, 2)) = br
Application.ScreenUpdating = True
MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub

Function ShellSort2D(ByRef ar, ByVal iFirst&, ByVal iLast&, ByVal iLeft&, _
ByVal iRight&, ByVal iKey&, Optional isOrder As Boolean = True)
Dim iRowSize&, vTemp, interval&, i&, j&, k&

ReDim vTemp(iLeft To iRight)
iRowSize = iLast - iFirst + 1
interval = 1

If iRowSize > 13 Then
      Do While interval < iRowSize
         interval = interval * 3 + 1
      Loop
      interval = interval \ 9
End If

Do While interval
      For i = iFirst + interval To iLast
         For j = iLeft To iRight
            vTemp(j) = ar(i, j)
         Next
         If isOrder Then
            For k = i - interval To iFirst Step -interval
                  If ar(k, iKey) <= vTemp(iKey) Then Exit For
                  For j = iLeft To iRight
                     ar(k + interval, j) = ar(k, j)
                  Next j
            Next k
         Else
            For k = i - interval To iFirst Step -interval
                  If ar(k, iKey) > vTemp(iKey) Then Exit For
                  For j = iLeft To iRight
                     ar(k + interval, j) = ar(k, j)
                  Next j
            Next k
         End If
         For j = iLeft To iRight
            ar(k + interval, j) = vTemp(j)
         Next
      Next i
      interval = interval \ 3
Loop
End Function