­ã´£³¡ªL

­«¼g//
Sub ¸ü¤J()
Dim Arr, Brr, xD, T$, R&, N&, i&, j%, S As Worksheet
ReDim Brr(1 To 30000, 1 To 14)
Call ²M°£
Set xD = CreateObject("Scripting.Dictionary")
For Each S In Sheets
    If S.Name = "¶×Á`" Then GoTo s01
    Arr = Range(S.[n1], S.[a65536].End(3))
    For i = 5 To UBound(Arr)
        T = Arr(i, 1): R = xD(T)
        If R = 0 Then
           N = N + 1: R = N: xD(T) = N
           Brr(N, 1) = T: Brr(N, 2) = Arr(i, 2)
        End If
        For j = 3 To UBound(Arr, 2)
            Brr(R, j) = Brr(R, j) + Val(Arr(i, j))
        Next j
    Next i
s01: Next
'------------------------------
With Sheets("¶×Á`").[a5].Resize(N, 14)
     .Value = Brr
     .Columns(7) = "=rank(f5," & .Columns(6).Address & ")"
     .Columns(14) = "=rank(M5," & .Columns(13).Address & ")"
End With
End Sub

Sub ²M°£()
Sheets("¶×Á`").UsedRange.Offset(4).ClearContents
End Sub


Xl0000040.rar (20.35 KB)

¤U¸ü¦¸¼Æ: 12

2023-10-9 11:54