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

[µo°Ý] ­«·s±Æ§Ç

¦^´_ 10# cowww


    ÁÂÁ«e½ú¦^´_,·Pı«e½ú¤W¯Z¼Ö¦b¨ä¤¤
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-5-26 16:34 ½s¿è

¦^´_ 10# cowww


    ÁÂÁ½׾Â,ÁÂÁ«e½ú¤@°_¾Ç²ß
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,±N±Æ§Ç©ñ¨ì³Ì«á,¤è®×»P¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú°Ñ¦Ò,¤@°_¾Ç²ß


Option Explicit
Sub TEST()
Application.ScreenUpdating = False
Dim Brr, Crr, V, A, Y, R&, i&, j%, C%, TT$, T1$, T3$, T4 As Date, T9$, N&, MC%
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([sheet1!I3], [sheet1!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Crr(1 To UBound(Brr), 1 To 100)
'¡ô«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V1~100
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   If i = 1 Then
      Crr(1, 1) = "¤u¸¹": Crr(1, 2) = "©m¦W | Display Name": Crr(1, 3) = "¤Ñ¼Æ": N = 1
   End If
   '¡ô¦pªG³B²z²Ä1¦C®É,¯S§O¥ý³B²zµ²ªGªíªº¼ÐÃD¦C
   T1 = Brr(i, 1): T3 = Brr(i, 3): T4 = Brr(i, 4): T9 = Brr(i, 9): TT = T1 & "|" & T3
   '¡ô¥O°}¦C­È¥HÅܼƲ±¸Ë,¥i©w¸qÅܼÆÃþ«¬,¤S¥iºë²µ{¦¡½X
   If T9 <> "°ê°²" Then GoTo i01
   '¡ô¦pªG°²§O¤£¬O "°ê°²" ´N¤£³B²z¸õ¹L
   If Y(TT) = "" Then N = N + 1: Y(TT) = N: Crr(N, 1) = T1: Crr(N, 2) = T3: Y(TT & "|C") = 3
   '¡ô¦pªGÃöÁä¦r¬Oªì¦¸¯Ç¤J¦r¨å,¥²¶·¥ý³B²z¼ÐÃDÄæ
   R = Y(TT): C = Y(TT & "|C"): C = C + 1: Y(TT & "|C") = C: If MC < C Then MC = C
   '¡ô±N¦r¨å¤¤¬ö¿ýªºÄæ¦ì,¦C¦ì´£¨ú¥X¨Ó,¨Ã§P©w³Ì«á¼g¤JÀx¦s®æ®ÉªºÄæ¼ÆMC
   Crr(R, C) = T4: Crr(R, 3) = Crr(R, 3) + 1
   '¡ô±N·s¤é´Á©ñ¤JCrr°}¦C¤¤,¤Ñ¼Æ­n²Ö¥[
i01: Next
For i = 4 To MC: Crr(1, i) = i - 3: Next
'¡ô±N¼ÐÃD¦C¤Ñ¼Æ¶ñ¤J
With Sheets("¤u§@ªí1")
   .UsedRange.ClearContents
   '¡ô²M°£µ²ªGªí¤º®e
   .Columns(1).NumberFormatLocal = "@"
   '¡ô¥Oµ²ªGªí²Ä1Äæ®æ¦¡¬O¤å¦r
   .Rows(1).NumberFormatLocal = "@"
   '¡ô¥Oµ²ªGªí²Ä1¦C®æ¦¡¬O¤å¦r
   With .[A1].Resize(N, MC)
      .Value = Crr
      '¡ô¥OCrr°}¦C­È¼g¤Jµ²ªGªí¤¤
      .Sort KEY1:=.Item(1), Order1:=1, Header:=1
      '¡ô¥O¸Ó½d³òÀx¦s®æ¥H²Ä1Ä欰°ò·Ç,°µ¦³¼ÐÃD¦Cªº¶¶±Æ§Ç
   End With
End With
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub


=============================================
¸É¥R:
   .Columns(1).NumberFormatLocal = "@"
   .Rows(1).NumberFormatLocal = "@"
¥i¦X¨Ö¬°:
   Union(.Columns(1), .Rows(1)).NumberFormatLocal = "@"
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 12# Andy2483

«D±`·PÁÂAndy2483¤j¤jªº¼ö¤ß¸Ñ´b

³o¬q»yªkµLªk°õ¦æ
½Ð°Ý³o¬q»yªk¸ò#9ªº»yªk¦³¦ó¤£¦P

TOP

¦^´_ 12# Andy2483


§Ñ°O±N¿ù»~°T®§µo¤W¨Ó¤F


TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-5-29 11:59 ½s¿è

¦^´_ 14# cowww


    ÁÂÁ«e½ú¦^´_
1.¸ê®Æªíªí¦W¬O sheet1,½Ð¬d¬Ý¸ê®Æªíªí©ú¬O§_§ó§ï
2.¸ê®ÆªíÄæ¦ì¬O§_ÅÜ°Ê
3.¦A¤£¦æ,½Ð¤W¶Ç½d¨ÒÀÉ

Brr = Range([sheet1!I3], [sheet1!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 15# Andy2483

«D±`·PÁÂAndy2483¤j¤jªºÀ°¦£
¿ù»~°T®§.PNG
¿ù»~°T®§2.PNG

2023°ê°²-VBA.zip (407.59 KB)
¸Ì­±¦³§Ú¥¿¦b½m²ßªº¤U©Ô¦¡¿ï³æªºÁp°Ê

TOP

¦^´_ 16# cowww


If T9 <> "°ê°²" Then GoTo i01
§ï¦¨
If T9 <> "National Holiday" Then GoTo i01
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 17# Andy2483

¦¨¥\¤F
«D±`·PÁÂAndy2483¤j¤jªº¸Ñ´b

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½Æ²ßª½¦¡§e²{¤è¦¡,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð





Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 2), A, Y, R&, i&, TT$, T1$, T3$, T4 As Date, T9$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([sheet1!I3], [sheet1!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥Hsheet1 ªíªºA~IÄæÀx¦s®æ­È±a¤J°}¦C¤¤
With Sheets("¤u§@ªí1").[A2].Resize(UBound(Brr), UBound(Brr, 2))
'¡ô¥H¤U¬OÃö©ó¦W¬° "¤u§@ªí1" ¤u§@ªíÂX®iBrr°}¦C½d³òªºµ{§Ç
   .Value = Brr
   '¡ô¥OÀx¦s®æ­È¬O Brr°}¦C­È
   .Sort KEY1:=.Item(1), Order1:=1, _
         Key2:=.Item(4), Order2:=1, Header:=2
   '¡ô¥O¸Ó½d³ò°µ2¼h¦¸,µL¼ÐÃD¦CªºÁa¦V¶¶±Æ§Ç
   Brr = .Value
   '¡ô¥OBrr¤Gºû°}¦C­È¬O¸Ó½d³ò±Æ§Ç«áªº°}¦C­È
End With
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   T1 = Brr(i, 1): T3 = Brr(i, 3): T4 = Brr(i, 4): T9 = Brr(i, 9)
   '¡ô¥OÅܼƸˤJ°}¦C­È,¤@¤è­±©w¸q¨ä­È,¤@¤è­±¥i¥HÁYµuµ{¦¡½X
   If T9 <> "°ê°²" Then GoTo i00
   '¡ô¦pªGT9ÅܼƤ£¬O "°ê°²"¦r¦ê,´N¸õ¨ìi00¦ì¸mÄ~Äò°õ¦æ
   TT = T1 & "|" & T3: A = Y(TT)
   '¡ô¥OTTÅܼƬO ²Õ¦X¦r¦ê,¥OAÅܼƬO ¥HTTÅܼƬdY¦r¨å¦^¶Çªºitem
   If Not IsArray(A) Then A = Crr: Y(TT & "/½s") = T1: Y(TT & "/¦W") = T3
   '¡ô¦pªGitem¤£¬O°}¦C?? ´N¥OAÅܼƬOCrr°}¦C(ªÅ°}¦C),
   '¥OTTÅܼƳs±µ "/½s"²Õ¦¨ªº·s¦r¦ê·íkey,item¬OT1ÅܼÆ,¯Ç¤JY¦r¨å¸Ì,
   '¥OTTÅܼƳs±µ "/¦W"²Õ¦¨ªº·s¦r¦ê·íkey,item¬OT3ÅܼÆ,¯Ç¤JY¦r¨å¸Ì

   R = Y(TT & "/R"): R = R + 1: Y(TT & "/R") = R
   '¡ô¥ORÅܼƬO TTÅܼƳs±µ "/R"²Õ¦¨ªº·s¦r¦ê¬dY¦r¨åªº¦^¶Ç­È,
   '¥ORÅܼƲ֥[ 1,
   '¥OTTÅܼƳs±µ "/R"²Õ¦¨ªº·s¦r¦ê·íkey,item¬O RÅܼÆ,¯Ç¤JY¦r¨å¸Ì

   A(R, 1) = T4: A(R, 2) = T9: Y(TT) = A
   '¡ô¥ORÅܼƦC²Ä1ÄæA°}¦C­È¬O T4ÅܼƭÈ,¥ORÅܼƦC²Ä2ÄæA°}¦C­È¬O T4ÅܼƭÈ,
   '¥OTTÅܼƷíkey,item¬OA¤Gºû°}¦C¯Ç¤JY¦r¨å¤¤

i00: Next
With Sheets("¤u§@ªí1")
'¡ô¥H¤U¬OÃö©ó¦W¬° "¤u§@ªí1" ¤u§@ªíªºµ{§Ç
   .UsedRange.Offset(1, 0).Clear: R = 1
   '¡ô¥O¨Ï¥ÎªºÀx¦s®æ©¹¤U°¾²¾1¦C½d³òªºÀx¦s®æ²M°£,¥ORÅܼƬO 1
   .Columns(1).NumberFormatLocal = "@"
   '¡ô¥OAÄæ®æ¦¡¬O ¤å¦r
   For Each A In Y.KEYS
   '¡ô³]³v¶µ°j°é,¥OAÅܼƬOY¦r¨å¸Ìªºkey
      If Not IsArray(Y(A)) Then GoTo i01
      '¡ô¦pªG¥HAÅܼƬdY¦r¨å¦^¶Ç±oitem¤£¬O °}¦C,´N¸õ¨ìi01¦ì¸m°õ¦æ
      R = R + 1
      '¡ô¥ORÅܼƲ֥[1
      .Cells(R, 1) = Y(A & "/½s"): .Cells(R, 2) = Y(A & "/¦W")
      '¡ô¥OÀx¦s®æ¼g¤J ­û¤u½s¸¹»P©m¦W
      .Cells(R, 3).Resize(Y(A & "/R"), 2) = Y(A): R = R + Y(A & "/R") - 1
      '¡ô¥O¾A·í½d³ò¼g¤JY¦r¨å©Ò¦^¶Çitem¤Gºû°}¦C­È
i01: Next
End With
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 19# Andy2483

«D±`·PÁÂAndy2483¤j¤jªºµù¸Ñ

TOP

        ÀR«ä¦Û¦b : °ß¨ä´L­«¦Û¤vªº¤H¡A¤~§ó«i©óÁY¤p¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD