[¤À¨É] Á`©M³Ì¦h©u¸`

hcm19522

¤U¸ü (16.13 KB)

2025-11-14 13:37

hcm19522

(·j´M ¿é¤J¸¹½X 14540) googleºô§}:https://hcm19522.blogspot.com/

Andy2483

¦^´_ 1# hcm19522


    ÁÂÁ«e½ú¤À¨É¦¹¥DÃD,«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (112.81 KB)

2025-11-19 15:56

°õ¦æµ²ªG:

¤U¸ü (131.04 KB)

2025-11-19 16:21

Option Explicit
Sub TEST()
Dim Brr, Z, i&, j%, M&, C%, N&, R&
Set Z = CreateObject("Scripting.Dictionary")
R = [A1].End(xlDown).Row
If R + 3 <= [A65536].End(3).Row Then
   Range(Cells(R + 3, "A"), [A65536].End(3)).EntireRow.Delete
End If
Brr = Range([M2], [A65536].End(3))
For i = 1 To UBound(Brr)
   M = 0
   For j = 0 To 3
      N = 0
      For C = 2 To 4
         N = N + Brr(i, j * 3 + C)
         Brr(i, j * 3 + C) = ""
      Next
      Brr(i, j * 3 + C - 3) = N
      If M < N Then
         Z(Brr(i, 1)) = j + 1
         M = N
      End If
   Next
Next
[O2].Resize(UBound(Brr), 1) = Application.Transpose(Z.Items)
Cells(R + 3, "A").Resize(UBound(Brr), 13) = Brr
End Sub