Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:

¤U¸ü (76.69 KB)

2023-12-12 09:43

°õ¦æµ²ªG:

¤U¸ü (92.53 KB)

2023-12-12 09:43

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, R&, C%, N&, X%, T$, Dx As Date
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([C2], [A65536].End(xlUp))
ReDim Crr(1000, 1000)
For i = 1 To UBound(Brr)
   Dx = Format(Brr(i, 1), "YY/MM/01"): R = Z(Dx)
   T = Trim(Brr(i, 2)): C = Z(T)
   If R = 0 Then N = N + 1: R = N: Z(Dx) = R: Crr(R, 0) = Dx
   If C = 0 Then X = X + 1: C = X: Z(T) = C: Crr(0, C) = T
   Crr(R, C) = Crr(R, C) + Brr(i, 3)
Next
T = [E1]: [E:Z].Clear: [E1] = T: [E1].HorizontalAlignment = xlCenter
With [E1].Resize(1, X + 2): .Merge: .Borders.LineStyle = 1: End With
If N * X = 0 Then Exit Sub
With [E2].Resize(N + 1, X + 2)
   .Value = Crr
   .Offset(0, 1).Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=2
   .Offset(1, 0).Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=1
   .Columns(1).NumberFormatLocal = "m""¤ë"""
   .Borders.LineStyle = 1
   .Columns(X + 2) = "=SUM(F2:" & Cells(2, X + 5).Address(0, 0) & ")"
   .Cells(1, 1) = "ºØÃþ": .Cells(1, X + 2) = "Á`­p"
End With
End Sub