ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

EXCEL°ê©w°²¤é¦Û°Ê§ó·s

EXCEL°ê©w°²¤é¦Û°Ê§ó·s

½Ð°Ý¦U¦ì¤j«e½ú
¥Ø«e¤p§Ì¦³°µ£¸¨Ç¸U¦~¾ä©Î¬O±M®×ªºÀÉ®×
¥Ø«e°ê©w°²¤é©Î¸É¯Z¤éªº¤é´Á³£¬O¦b¤À­¶¤W¥Î¤â°Êªº¤è¦¡¥´¤W

½Ð°Ý¦³¨S¦³¤°»ò¤è¦¡¥i¥HÅý¨C¦~ªº°ê©w°²¤é¤Î¸É¯Z¤é¥i¥H¦Û°Ê§ì¨ú¸ê®Æ©O¡H
§Ú¦Û¤v·Q¨ì¥i¯àªº¤è¦¡¦p¹³ªÑ²¼¨º¼Ë¥Îºô­¶§ì¨ú¸ê®Æªº¤è¦¡
¦ýÁÙ¤£½T©w¥i¦æ©Ê

¦A³Â·Ð¦U¦ì¤j¤jÀ°¦£¡A·PÁ¡I

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-6 12:11 ½s¿è

¦^´_ 1# ¬PªÅÉ@¦ÐÁl


    ÁÂÁ«e½úµoªí¦¹¥DÃD
½×¾Â¦³¹ïºô­¶§ì¨ú«Ü¼F®`ªº«e½ú!
¦pªG¤W¶Ç½d¨ÒÀÉ(¸U¦~¾ä©Î¬O±M®×ªºÀÉ®×)»P§iª¾·Q­n¥Î­þ­Ó¦æ¨Æ¾äºô­¶ºô§}°µ§ó·s,
¤ñ¸û¦³¾÷·|¦³¤è®×¥i¸Ñ¨M

TOP

¦^´_ 2# Andy2483
·PÁÂAndy2483«e½ú¦^ÂÐ
Àɮצpªþ¥ó
¤H­û°O¿ýªí ´ú¸Õ 20221206.rar (14.78 KB)

¥Ø«eªí³æ¬O»s§@¸U¦~¾úªº¼Ë¦¡
¥Î¨Ó°O¿ý¨C¤é¤¤À\¤H­û¼Æ¶q
¦ý¥u­n·sªº£¸¦~´N­n¦Û¤v¥Î¤â°Ê§ó·s¸É¯Z¤é¤Î¥ð°²¤é
·Q¨Ì·Ó¦æ¬F°|¤½§i¦æ¨Æ¾äªº¸É¯Z¤é¤Î¥ð°²¤é¶i¦æ§ó·s
¤£ª¾¹D¬O§_¥i¦æ©O¡H

p.s¤p§ÌÅv­­¤£¨¬¡AµLªk¶Kºô§}¡A­n³Â·Ð¦U¦ì¤j¤j¬d¤@¤U¬F°|¤½§i¦æ¨Æ¾ä¡A¤£¦n·N«ä

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-7 11:34 ½s¿è

¦^´_ 3# ¬PªÅÉ@¦ÐÁl
ÁÂÁ«e½ú¦^´_!½Ð¸Õ¸Õ¬Ý
«á¾ÇÂǦ¹ÃD½m²ß°}¦C»P¦r¨å,¾Ç¨ì«Ü¦hª¾ÃÑ,ÁÂÁÂ
1.¤U¸üÀÉ®×
¦æ¬F°|¤H¨ÆÁ`³B©xºô:
https://www.dgpa.gov.tw
112¦~¿ì¤½¤é¾äªí.xls¤U¸ü:
https://www.dgpa.gov.tw/FileConversion?filename=dgpa/files/202206/e71dbdb7-5339-48a7-b11e-172b2875df1e.xls&nfix=&name=112%E5%B9%B4%E8%BE%A6%E5%85%AC%E6%97%A5%E6%9B%86%E8%A1%A8.xls

2.±N¤U¦Cµ{¦¡½X©ñ¤JVBA§@°õ¦æ

¤U¸üÀÉ®×,¥¼°õ¦æ:


°õ¦æ«á:


Option Explicit
Sub ¤W¯Z¤é_°²¤é_¸É¯Z¤é()
Dim Brr, Sh1, V, xA, xR, Z, P, W, i&, n&, Ch$, y%, ymd As Date
Dim X&(4)
Set W = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set P = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("Sheet1")
Set Brr = Range(Sh1.[A1], Sh1.UsedRange)
Sh1.[AA:AH].ClearContents
V = Split(",¤@,¤G,¤T,¥|,¤­,¤»,¤C,¤K,¤E,¤Q,¤Q¤@,¤Q¤G", ",")
For i = 1 To 12
   Z(V(i) & "¤ë") = i
Next
For Each xR In Brr
   If xR Like "*¦è¤¸####¦~*" Then y = Mid(xR, InStr(xR, "¦è¤¸") + 2, 4)
   Ch = xR & xR.Item(, 2) & xR.Item(, 3)
   If Z.Exists(Ch) And xR.Item(, 3) <> "" Then
      Set W(Ch) = xR.Item(1, -1).Resize(14, 7)
   End If
Next
Z.Add "«D©P¥ð¤G¤é°²¤é", 1
Z.Add "©P¥ð¤G¤é", 3
Z.Add "¤W¯Z¤é", 5
Z.Add "¸É¯Z¤é", 7
For Each xR In W.KEYS
   For Each xA In W(xR)
      If IsNumeric(xA) And xA <> "" Then
         ymd = y & "/" & Z(xR) & "/" & xA
         If xA.Interior.ColorIndex <> -4142 Then
            If Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
               P(ymd) = "«D©P¥ð¤G¤é°²¤é"
               X(1) = X(1) + 1
               W(ymd) = X(1)
               Else
                  P(ymd) = "©P¥ð¤G¤é"
                  X(2) = X(2) + 1
                  W(ymd) = X(2)
            End If
            ElseIf Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
               P(ymd) = "¤W¯Z¤é"
               X(3) = X(3) + 1
               W(ymd) = X(3)
               n = n + 1
            Else
               P(ymd) = "¸É¯Z¤é"
               X(4) = X(4) + 1
               W(ymd) = X(4)
         End If
      End If
   Next
Next
ReDim Brr(1 To n, 1 To 8)
For Each xR In P.KEYS
   ymd = xR
   Brr(W(ymd), Z(P(ymd))) = ymd
   Brr(W(ymd), Z(P(ymd)) + 1) = Format(ymd, "aaaa")
Next
[AA1].Resize(1, 8) = [{"«D©P¥ð¤G¤é°²¤é","","©P¥ð¤G¤é","","¤W¯Z¤é","","¸É¯Z¤é",""}]
[AA2].Resize(n, 8) = Brr
Sh1.[AA:AH].Columns.AutoFit
[AA1].CurrentRegion.Borders.LineStyle = 1
Set W = Nothing: Set Z = Nothing: Set P = Nothing: Set Brr = Nothing
Erase V, X
End Sub

TOP

²K¥[²³æ¨¾¿ù:


Option Explicit
Sub ¤W¯Z¤é_°²¤é_¸É¯Z¤é()
Dim Brr, Sh1, V, xA, xR, Z, P, W, i&, n&, Ch$, y%, ymd As Date
Dim X&(4), T&
Set W = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set P = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("Sheet1")
Set Brr = Range(Sh1.[A1], Sh1.UsedRange)
Sh1.[AA:AH].ClearContents
V = Split(",¤@,¤G,¤T,¥|,¤­,¤»,¤C,¤K,¤E,¤Q,¤Q¤@,¤Q¤G", ",")
For i = 1 To 12
   Z(V(i) & "¤ë") = i
Next
For Each xR In Brr
   If xR Like "*¦è¤¸####¦~*" Then y = Mid(xR, InStr(xR, "¦è¤¸") + 2, 4)
   Ch = xR & xR.Item(, 2) & xR.Item(, 3)
   If Z.Exists(Ch) And xR.Item(, 3) <> "" Then
      Set W(Ch) = xR.Item(1, -1).Resize(14, 7)
   End If
Next
Z.Add "«D©P¥ð¤G¤é°²¤é", 1
Z.Add "©P¥ð¤G¤é", 3
Z.Add "¤W¯Z¤é", 5
Z.Add "¸É¯Z¤é", 7
For Each xR In W.KEYS
   For Each xA In W(xR)
      If IsNumeric(xA) And xA <> "" Then
         ymd = y & "/" & Z(xR) & "/" & xA
         If xA.Interior.ColorIndex <> -4142 Then
            If Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
               P(ymd) = "«D©P¥ð¤G¤é°²¤é"
               X(1) = X(1) + 1
               W(ymd) = X(1)
               Else
                  P(ymd) = "©P¥ð¤G¤é"
                  X(2) = X(2) + 1
                  W(ymd) = X(2)
            End If
            ElseIf Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
               P(ymd) = "¤W¯Z¤é"
               X(3) = X(3) + 1
               W(ymd) = X(3)
               n = n + 1
            Else
               P(ymd) = "¸É¯Z¤é"
               X(4) = X(4) + 1
               W(ymd) = X(4)
         End If
      End If
   Next
Next
For ymd = y & "/1/1" To y & "/12/31"
   If P.Exists(ymd) = Empty Then
      MsgBox "¯Ê¤Ö: " & ymd
      GoTo 111
   End If
   T = T + 1
Next

ReDim Brr(1 To n, 1 To 8)
For Each xR In P.KEYS
   ymd = xR
   Brr(W(ymd), Z(P(ymd))) = ymd
   Brr(W(ymd), Z(P(ymd)) + 1) = Format(ymd, "aaaa")
Next
[AA1].Resize(1, 8) = [{"«D©P¥ð¤G¤é°²¤é","","©P¥ð¤G¤é","","¤W¯Z¤é","","¸É¯Z¤é",""}]
[AA2].Resize(n, 8) = Brr
Sh1.[AA:AH].Columns.AutoFit
[AA1].CurrentRegion.Borders.LineStyle = 1
MsgBox y & "¦~ ¦@¦³ " & T & " ¤Ñ" & vbLf & _
       "«D©P¥ð¤G¤é°²¤é ¦@: " & X(1) & " ¤Ñ" & vbLf & _
       "©P¥ð¤G¤é ¦@: " & X(2) & " ¤Ñ" & vbLf & _
       "¤W¯Z¤é ¦@: " & X(3) & " ¤Ñ" & vbLf & _
       "¸É¯Z¤é ¦@: " & X(4) & " ¤Ñ"


111
Set W = Nothing: Set Z = Nothing: Set P = Nothing: Set Brr = Nothing
Erase V, X
End Sub

TOP

¦^´_ 4# Andy2483

·PÁÂAndy2483«e½úªº¦^ÂÐ
´ú¸Õ§¹¦¨¥i¥H¥¿±`¨Ï¥Î¡AÁÂÁ¡C

¥t¥~·Q½Ð°Ý¥i¥H¦Û°Ê§ì¨úºô­¶Àɮ׶Ü?
ÁÙ¬O£¸©w­n¤â°Ê¦Û¤v¤U¸ü©O?

TOP

¦^´_ 5# Andy2483

·PÁÂAndy2483«e½úªº¦^ÂÐ
½Ð°Ý¦¹¶K¤å»P¤W¤@½g
°£¤F¼W¥[Åã¥Ü¤Ñ¼Æ¥H¥~
ÁÙ¦³·s¼W©Î­×§ï¤°»ò¤º®e¶Ü¡H

TOP

¦^´_ 6# ¬PªÅÉ@¦ÐÁl


    ÁÂÁ«e½ú¦^´_
1.«e½ú­n¦æ¬F°|ªº¦æ¨Æ¾ä!¬d¦æ¬F°|¤H¨ÆÁ`³B©xºô¥u¬d¨ìªþ¥ó©Î¦æ¨Æ¾ä¹Ï¤ù!¨S¬d¨ì¥Hºô­¶¤å¦r§e²{ªº¦æ¨Æ¾ä,µ¥¬Ý«e½ú­Ìªº¨ä¥L¤è®×
2.³o§ó·s¦æ¨Æ¾äªº§@·~,¤@¦~§ó·s¤@¦¸,¦³¤°»ò¯S§Oªº»Ý­n¶Ü?»Ý­n¨C¤Ñ³£¦AÀˬd¤@¦¸?
3.¦pªG¦³ºô­¶¬O¥H¤å¦rªí®æ§e²{ªº¦æ¨Æ¾ä,À³¸Ó¦³¾÷·|²Å¦X«e½úªº»Ý¨D
4.«á¾Ç¤]·Q¥Hºô­¶§ó·sªº VBA ª¾ÃÑ

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-7 14:37 ½s¿è

¦^´_ 7# ¬PªÅÉ@¦ÐÁl


    °£¤F¼W¥[Åã¥Ü¤Ñ¼Æ¥H¥~,°õ¦æªºµ²ªG¨S¦³¤£¦P,²³æÀˬd¸ê®Æªí¦]½s¿è¦Óº|±¼ªº¤é´Á
±K¨¾Ãø!¨Ï¥ÎªÌÂÔ·V¬°¤§!

TOP

¦^´_ 8# Andy2483

·PÁÂAndy2483«e½úªº¦^ÂÐ
¤F¸Ñ
§Ú¥D­n¤]¬O·Q¤F¸Ñ¥Hºô­¶§ó·sVBA³o³¡¤À¡C
ÁÙ¬O«D±`·PÁ±zªº¸Ñµª¡I

TOP

        ÀR«ä¦Û¦b : ¡i®É¤é²öªÅ¹L¡j¤@­Ó¤H¦b¥@¶¡°µ¤F¦h¤Ö¨Æ¡A´Nµ¥©ó¹Ø©R¦³¦hªø¡C¦]¦¹¥²¶·»P®É¶¡Ävª§¡A¤Á²ö¨Ï®É¤éªÅ¹L¡C
ªð¦^¦Cªí ¤W¤@¥DÃD