| ©«¤l2843 ¥DÃD10 ºëµØ0 ¿n¤À2899 ÂI¦W0  §@·~¨t²Î¡e²¤¡f ³nÅ骩¥»¡e²¤¡f ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¡e²¤¡f µù¥U®É¶¡2013-5-13 ³Ì«áµn¿ý2025-10-18 
 | 
                
| Sub TEST() Dim Arr, Brr, xD, i&, j&, R&, C&, U&, T$
 Sheets("Á`ªí").UsedRange.Clear
 Set xD = CreateObject("Scripting.Dictionary")
 ReDim Brr(1 To 2000, 1 To 99)
 Brr(1, 1) = "¸¹½X"
 For i = 1 To Sheets.Count
 If Left(Sheets(i).Name, 1) <> "X" Then GoTo i99
 C = C + 1: Brr(1, C + 1) = Sheets(i).Name
 Arr = Sheets(i).UsedRange
 For j = 2 To UBound(Arr)
 T = Arr(j, 1): If T = "" Then GoTo j99
 U = xD(T)
 If U = 0 Then R = R + 1: U = R: xD(T) = R: Brr(U + 1, 1) = T
 Brr(U + 1, C + 1) = Brr(U + 1, C + 1) + Arr(j, 2)
 j99: Next j
 i99: Next i
 With Sheets("Á`ªí").[a1].Resize(R + 1, C + 2)
 .Columns(1).NumberFormatLocal = "@"
 .Value = Brr
 .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlYes
 .Columns(C + 2) = "=SUM(RC[-" & C & "]:RC[-1])"
 .Rows(R + 2) = "=n(SUM(R[-" & R & "]C:R[-1]C))"
 .Cells(1, C + 2) = "¦Xp": .Cells(R + 2, 1) = "¦Xp"
 Union(.Rows(1), .Rows(R + 2), .Columns(C + 2)).Font.Bold = True
 End With
 End Sub
 
 
  Xl0000008.rar (15.4 KB) 
 
 =============================
 | 
 |