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

[µo°Ý] ¤@­Ó®Æ¸¹¹ïÀ³¦h­ÓDateCode¤Î¼Æ¶q

[µo°Ý] ¤@­Ó®Æ¸¹¹ïÀ³¦h­ÓDateCode¤Î¼Æ¶q

¥»©«³Ì«á¥Ñ jsc0518 ©ó 2022-12-16 22:02 ½s¿è

Dear ¥ý¶i,
¤u§@ªíList¬°³Ì²×²£¥Í¤§³øªí
¤u§@ªíeb¬°¸ê®Æ®w(¹w­p¸ê®Æ®w¬ù¦³100,000¥ª¥k)

¤u§@ªíListªºAÄæ¦C¬°®Æ¸¹¡A¦Ó¨C¤@µ§®Æ¸¹·|¦³¤£¦PªºDateCode¡A¦Ó¨C¤@µ§DateCode³£¦³¹ïÀ³ªº®w¦s¼Æ¶q
·Q­n§e²{µe­±¦p¤U¡G


DÄæ~MÄ檺³¡¤À¡A­n¹B¥Î­þ¤@¨ç¼Æ¤~¥i¥H°µ¨ì¤W­z¹Ï¤ù¤¤ªºª¬ªp©O¡H

¤U¹Ï¬°¸ê®Æ®w(¤u§@ªíeb)µe­±


§ä§å¸¹¼Æ¶q.rar (7.89 KB)

ÁٽЦU¦ì¥ý¶i«ü¾É¸Ñ´b¡IÁÂÁ¤j®a¡I
Just do it.

¦^´_ 6# hcm19522
·PÁÂhcm19522ªº¼ö¤ß¦^´_¡A¨S·Q¨ìExcel¤½¦¡ÁÙ¬O¥i¥H±a¥X¯S®í±ø¥ó»Ý¨D¡C
·PÁ±z´£¨Ñªº¸Ñµª¡AÁÂÁ±z¡I:)
Just do it.

TOP

¦^´_ 6# hcm19522


    «e½ú¼F®`,¤@¦æ¤½¦¡¥i¥H¨ú¥N«á¾Ç·Q¯}ÀYªºVBA
«e½ú¥i¥H¼·ªÅ²³æ´£ÂI¤@¤U³Ð¥ß³o¤@ªø¦ê¤½¦¡ªº«ä¸ô¶Ü?
ÁÂÁ«e½ú
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¥»©«³Ì«á¥Ñ 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©w­n§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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# Andy2483
Dear Andy,
±z¯u¼F®`¡A³oVBA»yªk¥i¥H¨Ï¥Î¼Ú¡A·P®¦·P®¦¡I
:)
Just do it.

TOP

¦^´_ 1# jsc0518


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ»P¸gÅç,½m²ß¦r¨å»P°}¦C,ªì¦¸½m²ß»²§Uªí±Æ§Ç
¥H¤U¾Ç²ßµ²ªG½Ð«e½ú¸Õ¸Õ¬Ý,ÁÂÁÂ

°õ¦æ«e:


°õ¦æµ²ªG:


Option Explicit
Sub TEST_20221220()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Arr, i&, j&, T1$, T3&, T6$, W, X, Y, Z, C, R, m, N, S
Set X = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
Set W = CreateObject("Scripting.Dictionary")
Arr = Range([eb!F2], [eb!A1].Cells(Rows.Count, 1).End(xlUp))
For i = 1 To UBound(Arr)
   If W(Arr(i, 1)) = Empty Then
      S = S + 1
      W(Arr(i, 1)) = S
      Arr(i, 2) = S
      Else
         Arr(i, 2) = W(Arr(i, 1))
   End If
Next
With Sheets.Add
   With .[A1].Resize(UBound(Arr), UBound(Arr, 2))
      .Value = Arr
      .Sort _
      KEY1:=.Item(2), Order1:=xlAscending, _
      Key2:=.Item(6), Order2:=xlAscending, _
      Header:=xlNo, Orientation:=xlTopToBottom
       Arr = .Value
   End With
   .Delete
End With
For i = 1 To UBound(Arr)
   T1 = Arr(i, 1)
   T3 = Arr(i, 3)
   T6 = Arr(i, 6)
   If X(T1 & "|" & T6) = Empty Then
      Y(T1) = Y(T1) + 1
      X(T1 & "|" & T6) = Y(T1)
      If Y(T1) > m Then m = Y(T1)
   End If
   W(T1 & "|" & T6) = W(T1 & "|" & T6) + T3
Next
ReDim Arr(1 To Y.Count, 1 To m + 3)
For Each R In Y.KEYS
   N = N + 1
   Arr(N, 1) = "'" & R
   Y(R) = N
Next
For Each C In X.KEYS
   Arr(Y(Split(C, "|")(0)), X(C) + 3) = Split(C, "|")(1) & "/" & W(C)
Next
Sheets("List").UsedRange.Offset(1, 0).Clear
With [List!A2].Resize(UBound(Arr), UBound(Arr, 2))
    .Value = Arr
End With
Set X = Nothing
Set Y = Nothing
Set Z = Nothing
Set Arr = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 1# jsc0518


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç¬ã¨s¹L¤@©«,¦³ÂIÃþ¦ü,³sµ²¦p¤U¨Ñ°Ñ¦Ò:
http://forum.twbts.com/viewthrea ... E%E3%B2z&page=1
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¬Ý§O¤H¤£¶¶²´¡A¬O¦Û¤v­×¾i¤£°÷¡C
ªð¦^¦Cªí ¤W¤@¥DÃD