- ©«¤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 ©ó 2022-12-21 10:32 ½s¿è
¦^´_ 4# jsc0518
ÁÂÁ«e½ú¦^´_
¤µ¤Ñ¦A½Æ²ß¤F¤@¤U,ÅÞ¿è§ó²M·¡,¤]µo²{¤@¨Ç¯Êº|»PÂØz
¥H¤U¬O¤ß±oµù¸Ñ,½Ð«e½ú°Ñ¦Ò,¤]½Ð¦U¦ì«e½ú«ü¾É,ÁÂÁÂ
Option Explicit
Sub TEST_20221220()
Application.DisplayAlerts = False
'¡ô°õ¦æ¹Lµ{¤£n¸õ¥X(°Ý¤u§@ªí¬O¤£¬O½T©wn§R°£?)µøµ¡
'https://learn.microsoft.com/zh-tw/office/vba/api/excel.application.displayalerts
Application.ScreenUpdating = False
'¡ô¿Ã¹õ¤£ÀHµÛµ{¦¡°õ¦æÅܤƵ²ªG
Dim i&, T3&, m&, N&, T1$, T6$, Arr, W, X, Y, Z, C, R, S
'¡ô«Å§iÅܼÆ:(i,T3,m,N)¬Oªø¾ã¼ÆÅܼÆ,(T1,T6)¬O¦r¦êÅܼÆ,¨ä¥Lªº¬O³q¥Î«¬ÅܼÆ
Set X = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
Set W = CreateObject("Scripting.Dictionary")
'¡ô¥OX,Y,Z ¦U¬O ¦r¨å
Arr = Range([eb!F2], [eb!A1].Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArr¬O¤Gºû°}¦C!ˤJ±qebªí[F2]¨ìebªíAÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ,
'ÂX®i¥X³Ì¤p¤è¥¿°Ï°ìÀx¦s®æªºÈ
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
If W(Arr(i, 1)) = Empty Then
'¡ô¦pªG¥Hi°j°é¦C²Ä1Ä檺Arr°}¦CȬdW¦r¨å¬O¨S¦³³okey??
S = S + 1
'¡ôif±ø¥ó¦¨¥ß!´NÅýS²Ö¥[1
W(Arr(i, 1)) = S
'¡ô¥Oi°j°é¦C²Ä1Ä檺Arr°}¦CÈ·íkey,Item¬O SÅܼÆ
Arr(i, 2) = S
'¡ô¥Oi°j°é¦C²Ä2Ä檺Arr°}¦CȤ]¬O SÅܼÆ
Else
'¡ô¥H¤U¬Oif±ø¥ó¤£¦¨¥ß¤~°õ¦æªº
Arr(i, 2) = W(Arr(i, 1))
'¡ô¥Oi°j°é¦C²Ä2Ä檺Arr°}¦CȬO ¥Hi°j°é¦C²Ä1Ä檺Arr°}¦CȬdW¦r¨å±o¨ìªºitemÈ
End If
Next
With Sheets.Add
'¡ô¥H¤U¬OÃö©ó·s¼W¤@Ó¤u§@ªíªºµ{§Ç
With .[A1].Resize(UBound(Arr), UBound(Arr, 2))
'¡ô¥H¤U¬OÃö©ó·s¼W¤u§@ªí¸Ì[A1]¦V¤UÂX®i Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ,
'¦V¥kÂX®i Arr°}¦C¾î¦V¦V³Ì¤j¯Á¤ÞÄ渹¼Æ,³o¤è¥¿½d³òÀx¦s®æªºµ{§Ç
.Value = Arr
'¡ô¥O³o½d³òÀx¦s®æÈ ¥HArr°}¦CÈˤJ
.Sort _
KEY1:=.Item(2), Order1:=xlAscending, _
Key2:=.Item(6), Order2:=xlAscending, _
Header:=xlNo, Orientation:=xlTopToBottom
'¡ô¥O¥H²Ä2Äæ°µ²Ä¤@¼h°µ¨S¦³¼Ð¦Cªº¤W¤U¶¶±Æ§Ç,²Ä6Äæ¦P®É°µ²Ä¤G¼h¤W¤U¶¶±Æ§Ç
Arr = .Value
'¡ô¥OArr°}¦C˱¼ì¨ÓªºÈ,¸Ë¤J³o±Æ§Ç¦nªºÀx¦s®æÈ
End With
.Delete
'¡ô¥O³o·s¼W¤u§@ªí§R°£
End With
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1¨ì Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ
T1 = Arr(i, 1)
'¡ô¥OT1³o¦r¦êÅܼƬO i°j°é¦C²Ä1Ä檺Arr°}¦CÈ
T3 = Arr(i, 3)
'¡ô¥OT3³oªø¾ã¼ÆÅܼƬO i°j°é¦C²Ä3Ä檺Arr°}¦CÈ
T6 = Arr(i, 6)
'¡ô¥OT6³o¦r¦êÅܼƬO i°j°é¦C²Ä6Ä檺Arr°}¦CÈ
If X(T1 & "|" & T6) = Empty Then
'¡ô¦pªG¥H T1¦r¦êÅܼƳs±µ "|" ²Å¸¹,¦A³s±µT6¦r¦êÅÜ¼Æ ªº·s¦r¦ê¬dW¦r¨å! ¬O¨S¦³³okey??
Y(T1) = Y(T1) + 1
'¡ô¥O¥H T1¦r¦êÅܼƷíkey,Item¬O¦Û¤v +1 ©ñ¨ì¦r¨å¸Ì©Î´£¥X¨Ó+1¦A©ñ¦^¥h
X(T1 & "|" & T6) = Y(T1)
'¡ô¥O¥H T1¦r¦êÅܼƳs±µ "|" ²Å¸¹,¦A³s±µT6¦r¦êÅÜ¼Æ ªº·s¦r¦ê·íkey,item¬O Y(T1) ©ñ¨ì¦r¨å¸Ì
If Y(T1) > m Then m = Y(T1)
'¡ô¦pªG¥H T1¦r¦êÅܼƬdY¦r¨åªºitemȬO ¤j©ó m³oªø¾ã¼ÆÅܼÆ,
'´NÅým±a¤J T1¦r¦êÅܼƬdY¦r¨åªºitemÈ
End If
W(T1 & "|" & T6) = W(T1 & "|" & T6) + T3
'¡ô¥OT1¦r¦êÅܼƳs±µ "|" ²Å¸¹,¦A³s±µT6¦r¦êÅÜ¼Æ ªº·s¦r¦ê·íkey,
'Item¬O¦Û¤v + T3³oªø¾ã¼ÆÅÜ¼Æ ©ñ¨ì¦r¨å¸Ì©Î´£¥X¨Ó+1¦A©ñ¦^¥h
Next
ReDim Arr(1 To Y.Count, 1 To m + 3)
'¡ô«Å§iArr°}¦Cªº½d³ò!Áa¦V±q1¨ìY¦r¨å¸Ìkeyªº¼Æ¶q,¾î¦V±q1¨ì mªø¾ã¼ÆÅܼÆ+3
For Each R In Y.KEYS
'¡ô³]¶¶°j°é!¥OR³o³q¥Î«¬ÅܼƬO Y¦r¨å¸Ìªºkey,±q«e±½ü¨ì³Ì«á±
N = N + 1
'¡ô¥ON³oªø¾ã¼ÆÅܼƲ֥[ 1
Arr(N, 1) = "'" & R
'¡ô¥ONªø¾ã¼ÆÅܼƦC²Ä1ÄæArr°}¦CȬO "'"²Å¸¹³s±µR°j°ékeyÈ
Y(R) = N
'¡ô¥OR°j°ékeyÈ·íY°}¦Cªºkey,item¬ONªø¾ã¼ÆÅܼÆ
Next
For Each C In X.KEYS
'¡ô³]¶¶°j°é!¥OC³o³q¥Î«¬ÅܼƬO X¦r¨å¸Ìªºkey,±q«e±½ü¨ì³Ì«á±
Arr(Y(Split(C, "|")(0)), X(C) + 3) = Split(C, "|")(1) & "/" & W(C)
'¡ô¥OArr°}¦C (C°j°ékeyÈ¥H"|"²Å¸¹¤À³Î¦¨¤@ºû°}¦C«á ¨ú¯Á¤Þ¸¹0ªº°}¦CÈ ·íkey¬dY¦r¨å±oitemÈ)¦C,
'(C°j°ékeyÈ ·íkey¬dY¦r¨å±oitemÈ+3)Äæ ªºÈ¬O,
'C°j°ékeyÈ¥H"|"²Å¸¹¤À³Î¦¨¤@ºû°}¦C«á¨ú¯Á¤Þ¸¹1ªº°}¦Cȳs±µ "/"²Å¸¹,
'¦A³s±µ ¥HC°j°ékeyȬdW¦r¨åªºitemÈ
Next
Sheets("List").UsedRange.Offset(1, 0).Clear
'¡ô¥O"List"¤u§@ªí¦³¨Ï¥ÎªºÀx¦s®æÂX®i³Ì¤p¤è¥¿°Ï°ì¦A©¹¤U°¾²¾¤@¦Cªº°Ï°ìÀx¦s®æ ²M°£
[List!A2].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
'¡ô¥O"List"¤u§@ªí[A2]©¹¤UÂX®i Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ,
'©¹¥kÂX®iArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ³o¤è¥¿°Ï°ìªºÀx¦s®æȬO Arr°}¦CÈ
Set X = Nothing
Set Y = Nothing
Set Z = Nothing
Set Arr = Nothing
'¡ô¥O³o¨ÇÅܼÆÄÀ©ñ
End Sub |
|