- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-8 10:20 ½s¿è
¦^´_ 11# ¬PªÅÉ@¦ÐÁl
ÁÂÁ«e½ú¦A¦^´_
¤À¨É«p¾Ç(«pÁy¥Ö¾Ç¥Í)ªº¤ß±o
¤ß±oµù¸Ñªº¹Lµ{¦A¦¸Àˬd¨ì«Ü¦h¯Êº|!
©ú¦~§À¦æ¬F°|µo¥¬ªº2024¦~¦æ¨Æ¾ä®æ¦¡¦pªG¨SÅÜ??À³¸Ó¥i¥HÄò¥Î
¬¡¤Æ¸£²ÓM,¦ÒÅç¦Û¤v«í¤ß@¤ßªº³Ì¨Î¿ï¾Ü ³Â»¶®a±Ú°Q½×ª©ª©
ÁÂÁ½׾Â
Option Explicit
Sub ¤W¯Z¤é_°²¤é_¸É¯Z¤é()
Dim Brr, Sh1, V, xA, xR, Z, P, W
'¡ô«Å§i³o¨ÇÅܼƬO³q¥Î«¬ÅܼÆ
Dim i&, n&, T&
'¡ô«Å§i³o¨ÇÅܼƬOªø¾ã¼Æ
Dim X&(4), Ch$, y%, ymd As Date
'¡ô«Å§iX¬O¤@ºû°}¦C(0~4),(Ch)¬O¦r¦êÅܼÆ,(y)¬Oµu¾ã¼ÆÅܼÆ,(ymd)¬O¤é´ÁÅܼÆ
Set W = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set P = CreateObject("Scripting.Dictionary")
'¡ô¥OW.Z.P¦U¬O¦r¨å
Set Sh1 = Sheets("Sheet1")
'¡ô¥OSh1 ¬O"Sheet1" ¤u§@ªí(ªí¤@)
Set Brr = Range(Sh1.[A1], Sh1.UsedRange)
'¡ô¥OBrr¬Oªí¤@[A1]¨ì ªí¤@¦³¨Ï¥ÎÀx¦s®æ¤§¶¡ ÂX®i¬°³Ì¤p¤è¥¿½d³òªºÀx¦s®æ¶°
Sh1.[AA:AH].ClearContents
'¡ô¥OÄæ¦ì²M°£Àx¦s®æ¤º®e
V = Split(",¤@,¤G,¤T,¥|,¤,¤»,¤C,¤K,¤E,¤Q,¤Q¤@,¤Q¤G", ",")
'¡ô¥OV¬O Âù¤Þ¸¹¸Ìªº¦r¦ê¥H ","²Å¸¹¤À³Î¦¨ªº¤@ºû¦r¦ê°}¦C(PS:²Ä¤@Ó¬O"",¯Á¤Þ¸¹¬O0)
For i = 1 To 12
'¡ô³]¶¶°j°é!i±q1¨ì12
Z(V(i) & "¤ë") = i
'¡ô¥OV¤@ºû°}¦Cªº°j°é¯Á¤Þ¸¹¦ì¸mªº¦r¦ê¬°key,item¬O°j°é¼Æ,˶i¦r¨å¸Ì
Next
For Each xR In Brr
'¡ô³]¶¶°j°é!¥OxR¬O BrrÀx¦s®æ¶°¸Ìªº¤@®æ!¥Ñ¥ª¦Ü¥k/¤W¦Ü¤U¶]
If xR Like "*¦è¤¸####¦~*" Then y = Mid(xR, InStr(xR, "¦è¤¸") + 2, 4)
'¡ô¦pªGxRªºÈ ¸Ì±ªº¦r¤¸²Õ¦X¦³¥]§t "¦è¤¸" ³s±µ4ӼƦr ¦A³s±µ"¦~" ??
'±ø¥ó¦¨¥ß!¥Oy¬O ¨úxRȪº "¦è¤¸"¦r¤¸¦ì¸m+2 ¶}©l,¨ú4Ó¦r¤¸ªºÈ PS:2023
Ch = xR & xR.Item(, 2) & xR.Item(, 3)
'¡ô¥OCh¦r¦êÅܼƬO xRªºÈ³s±µ ¥kÃä®æªºÈ,¦A³s±µ¥k2®æªºÈ
If Z.Exists(Ch) And xR.Item(, 3) <> "" Then
'¡ô¦pªG¥HCh¦r¦êÅܼƬd¹îZ¦r¨å¬O¦³³okey,¦Ó¥BxR ¥k2®æªºÈ¤£¬OªÅ¦r¤¸ ??
Set W(Ch) = xR.Item(1, -1).Resize(14, 7)
'¡ô¥O¥OCh¦r¦êÅܼƷíkey,ITEM¬OxRÀx¦s®æ¥ª2Àx¦s®æ¶}©l,
'ÂX®iÁa¦V¦V¤U14¦C(§t¦Û¨),¾î¦V7Äæ(§t¦Û¨)ªºÀx¦s®æ½d³ò
'PS:item¥i¥H¬OÀx¦s®æ¶°!
End If
Next
Z.Add "«D©P¥ð¤G¤é°²¤é", 1
'¡ô¥O"«D©P¥ð¤G¤é°²¤é"¦r¦ê·íkey,item¬O¼Æ¦r 1,ˤJZ¦r¨å¸Ì
Z.Add "©P¥ð¤G¤é", 3
'¡ô¥O"©P¥ð¤G¤é"¦r¦ê·íkey,item¬O¼Æ¦r 3,ˤJZ¦r¨å¸Ì
Z.Add "¤W¯Z¤é", 5
'¡ô¥O"¤W¯Z¤é"¦r¦ê·íkey,item¬O¼Æ¦r 5,ˤJZ¦r¨å¸Ì
Z.Add "¸É¯Z¤é", 7
'¡ô¥O"¸É¯Z¤é"¦r¦ê·íkey,item¬O¼Æ¦r 7,ˤJZ¦r¨å¸Ì
For Each xR In W.KEYS
'¡ô³]¥~¶¶°j°é!¥OxR¬O W¦r¨å¸Ìkeysªº¤@Áä!¥Ñ«e¨ì«á¶]
For Each xA In W(xR)
'¡ô³]¤º¶¶°j°é!¥OxA¬O ¥HxR¦r¦ê¬d¹îW¦r¨å±o¨ìªºitemÀx¦s®æ¶°ªº¤@®æ,
'¥Ñ¥ª¦Ü¥k/¤W¦Ü¤U¶]
If IsNumeric(xA) And xA <> "" Then
'¡ô¦pªG¥ÎIsNumeric()¨ç¼ÆÀˬdxAÀx¦s®æȬO¼Æ¦r,¦Ó¥BxAÀx¦s®æȤ£¬OªÅ¦r¤¸ ??
ymd = y & "/" & Z(xR) & "/" & xA
'¡ô¥Oymd¤é´ÁÅܼƬO y³s±µ "/"²Å¸¹ ³s±µ¥HxR¦r¦ê¬d¹îZ¦r¨å±o¨ìªºitemÈ,
'¦A³s±µ "/"²Å¸¹,Ä~Äò±µxAÀx¦s®æÈ ¦r¦ê¤§«á,Åܦ¨¤é´Á
If xA.Interior.ColorIndex <> -4142 Then
'¡ô¦pªGxAÀx¦s®æ©³¦â¤£¬O µL©³¦â ??
If Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
'¡ô¦A¦pªGymd³o¤é´Á¦pªG¬O¬P´Á¤@¨ì¬P´Á¤¤§¶¡ªº¤é¤l ??
P(ymd) = "«D©P¥ð¤G¤é°²¤é"
'¡ôÂùIf±ø¥ó³£¦¨¥ß!´N¥H³oymd¤é´Á·íkey,item¬O "«D©P¥ð¤G¤é°²¤é"¦r¦ê,
'ˤJP¦r¨å
X(1) = X(1) + 1
'¡ô¥OX°}¦C²Ä¤GÓÈ +1 PS:(¯Á¤Þ¸¹¬O1)
W(ymd) = X(1)
'¡ô¥O¥Hymd¤é´Á·íkey,item¬O X°}¦C²Ä¤GÓÈ PS:X°}¦C²Ä¤@ÓȬO ""
Else
'¡ô¥H¤U §_«h ªºªº³¯z
P(ymd) = "©P¥ð¤G¤é"
'¡ô¥O¥H³oymd¤é´Á·íkey,item¬O "©P¥ð¤G¤é"¦r¦ê,ˤJP¦r¨å
X(2) = X(2) + 1
'¡ô¥OX°}¦C²Ä¤TÓÈ +1 PS:(¯Á¤Þ¸¹¬O2)
W(ymd) = X(2)
'¡ô¥O¥Hymd¤é´Á·íkey,item¬O X°}¦C²Ä¤TÓÈ
End If
ElseIf Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
'¡ô¦pªGxAÀx¦s®æ©³¦â¬O µL©³¦â! ¦A½T©wymd³o¤é´Á¦pªG¬O¬P´Á¤@¨ì¬P´Á¤¤§¶¡ªº¤é¤l ??
P(ymd) = "¤W¯Z¤é"
'¡ô¥O¥H³oymd¤é´Á·íkey,item¬O "¤W¯Z¤é"¦r¦ê,ˤJP¦r¨å
X(3) = X(3) + 1
'¡ô¥OX°}¦C²Ä¥|ÓÈ +1 PS:(¯Á¤Þ¸¹¬O3)
W(ymd) = X(3)
'¡ô¥O¥Hymd¤é´Á·íkey,item¬O X°}¦C²Ä¥|ÓÈ
n = n + 1
'¡ô¥On²Ö¥[ 1 PS:³o¬OnºâBrr°}¦C«Å§iÁa¦V½d³òªº¼Æ¶q
Else
'¡ô¦pªGxAÀx¦s®æ©³¦â¬O µL©³¦â! ¦A½T©wymd³o¤é´Á¦pªG¤£¬O¬P´Á¤@¨ì¬P´Á¤¤§¶¡ªº¤é¤l ??
P(ymd) = "¸É¯Z¤é"
'¡ô¥O¥H³oymd¤é´Á·íkey,item¬O "¸É¯Z¤é"¦r¦ê,ˤJP¦r¨å
X(4) = X(4) + 1
'¡ô¥OX°}¦C²Ä¤ÓÈ +1 PS:(¯Á¤Þ¸¹¬O4)
W(ymd) = X(4)
'¡ô¥O¥Hymd¤é´Á·íkey,item¬O X°}¦C²Ä¤ÓÈ
End If
End If
Next
Next
For ymd = y & "/1/1" To y & "/12/31"
'¡ô³]¤é´Á¶¶°j°é!±q¦~ªì¶]¨ì¦~§À
If P.Exists(ymd) = Empty Then
'¡ô¦pªG¥H°j°é¤é´Á¬d¹îP¦r¨å,¬O¨S¦³³oÓÁä PS:Empty¬Oªì©lÈ
MsgBox "¯Ê¤Ö: " & ymd
'¡ô¸õ¥X "¯Ê¤Ö: " ³s±µ°j°é¤é´Á¦r¦êªº´£¥Üµ¡
GoTo 111
'¡ô«ö¤F½T»{«á´N¸õ¨ì 111ªº¦ì¸mÄ~Äò°õ¦æ PS:¯Ê¤é´Á´N¤£¶]¤F
End If
T = T + 1
'¡ô¥OT¼Æ¦rÅܼƲ֥[ 1
Next
ReDim Brr(1 To n, 1 To 8)
'¡ô§â쥻¬OÀx¦s®æ¶°ªºBrrÅܨ!«Å§i¦¨¬°¤Gºû°}¦C,
'Áa¦V±q1¨ìnÅܼƦC,¾î¦V±q1¨ì8Äæ
For Each xR In P.KEYS
'¡ô³]¶¶°j°é!¥OxR¬O P¦r¨å¸Ìkeysªº¤@Áä!¥Ñ«e¨ì«á¶]
ymd = xR
'¡ô¥Oymd¤é´ÁÅܼƸËxRªºÈ PS:¦pªG¨S°O¿ùªº¸Ü!P¦r¨åÀ³¸Ó¬O¸Ë ¦~ªì¨ì¦~§Àªº¤é´ÁÁä,¤é§Oitem
Brr(W(ymd), Z(P(ymd))) = ymd
'¡ô¥O(ymd¬d¹îW¦r¨å±o¨ìªºitemÈ)¬°¦C¸¹,(ymd¬d¹îZ¦r¨å±o¨ìªºitemÈ)¬°Ä渹ªºBrr°}¦CȬO ymd¤é´Á
Brr(W(ymd), Z(P(ymd)) + 1) = Format(ymd, "aaaa")
'¡ô¥O¥kÃä¾F©~Brr°}¦CȬO°ê¦r¬P´Á¼Æ
Next
Sh1.[AA1].Resize(1, 8) = [{"«D©P¥ð¤G¤é°²¤é","","©P¥ð¤G¤é","","¤W¯Z¤é","","¸É¯Z¤é",""}]
'¡ô¥Oªí¤@[AA1]¦V¤UÂX®i1¦C(¦Û¨¦C),¦V¥kÂX®i8Ä檺Àx¦s®æ,¥H¤@ºû°}¦CÈ˶i¥h
Sh1.[AA2].Resize(n, 8) = Brr
'¡ô¥Oªí¤@[AA2]¦V¤UÂX®in¦C(§t¦Û¨¦C),¦V¥kÂX®i8Ä檺Àx¦s®æ,¥HBrr°}¦CÈ˶i¥h
Sh1.[AA:AH].Columns.AutoFit
'¡ô¥Oªí¤@[AA:AH]Äæ¼e¦Û°Ê½Õ¾ã
Sh1.[AA1].CurrentRegion.Borders.LineStyle = 1
'¡ô¥Oªí¤@[AA1]Àx¦s®æ¤K¤è¬Û¾F±µÀsªºÀx¦s®æÂX®iªº³Ì¤p¤è¥¿½d³òÀx¦s®æ,ªº®æ½u¬O²Ó¹ê½u
MsgBox y & "¦~ ¦@¦³ " & T & " ¤Ñ" & vbLf & _
"«D©P¥ð¤G¤é°²¤é ¦@: " & X(1) & " ¤Ñ" & vbLf & _
"©P¥ð¤G¤é ¦@: " & X(2) & " ¤Ñ" & vbLf & _
"¤W¯Z¤é ¦@: " & X(3) & " ¤Ñ" & vbLf & _
"¸É¯Z¤é ¦@: " & X(4) & " ¤Ñ"
'¡ô¸õ¥X´£¥Üµ¡!Åã¥Ü¦U¤é§O²Îp¤Ñ¼Æ
111
Set W = Nothing: Set Z = Nothing: Set P = Nothing: Set Brr = Nothing
Erase V, X
End Sub |
|