- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-31 16:23 ½s¿è
¦^´_ 24# gctsai
ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨ÒÀÉ
«á¾ÇÂǦ¹©«¬ã¨s¸ê®Æªí±Æ§Ç«á¤~±a¤J°}¦C,¸ê®Æªí´_ì,±µµÛ¤~¶i¦æ²Îp,
¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
¨Ó·½ªí:
²Îpªí:µ²ªG
Option Explicit
Sub «Å§i()
Dim Brr, Crr, Y, N&, C&, R&, i&, j&, T$, T2$, T3$, TT$
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("¨Ó·½"): Set Sh2 = Sheets("²Îp")
C = Sh1.UsedRange.Columns.Count: R = Sh1.UsedRange.Rows.Count
With Range(Sh1.[A1], Sh1.Cells(R, C + 1))
With .Columns(C + 1): .Value = "=ROW(A1)": .Value = .Value: End With
.Sort KEY1:=.Item(3), Order1:=1, Key2:=.Item(2), Order2:=1, Header:=1
Brr = .Value
.Sort KEY1:=.Item(C + 1), Order1:=1, Header:=1: .Columns(C + 1).Delete
End With
For i = 2 To UBound(Brr)
T = Brr(i, 3): If Y(T) = "" Then Y(T) = Y.Count: Y(T & "|Àx¦ì¼Æ") = ""
Next
Sh2.UsedRange.Delete
With Sh2.[A1].Resize(1, Y.Count)
.Value = Y.keys: .Replace "*|", "", Lookat:=xlPart
End With
ReDim Crr(1 To R, 1 To Y.Count)
For i = 2 To UBound(Brr)
T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T3 & "|" & T2
If Y(TT) = "" Then
Y(T3 & "/r") = Y(T3 & "/r") + 1
Crr(Y(T3 & "/r"), Y(T3)) = T2
Crr(Y(T3 & "/r"), Y(T3) + 1) = 1
Y(TT) = 1
Else
N = Y(T3 & "/r")
Crr(N, Y(T3) + 1) = Crr(N, Y(T3) + 1) + 1
End If
Next
With Sh2.[A2].Resize(UBound(Crr), UBound(Crr, 2))
.Value = Crr: .EntireColumn.AutoFit
End With
Set Y = Nothing: Erase Brr, Crr: Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub |
|