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

[µo°Ý] ¦p¦ó§P©w®Æ¸¹+§å¸¹¨ä¥Í²£¤Ñ¼Æ

[µo°Ý] ¦p¦ó§P©w®Æ¸¹+§å¸¹¨ä¥Í²£¤Ñ¼Æ

Dear all,
¹Ïªí»¡©ú¦p¤U¹Ï¡C¬O§_¦³¤½¦¡¥i¥H±a¥X§Ú·Q­nªºµ²ªG¡A²{ªp¬O¥H¤H¤u­pºâ¡A±`·|¥X¿ù
Thank you.

133.rar (8.86 KB)

Just do it.

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-11-28 14:16 ½s¿è

¦^´_ 18# ­ã´£³¡ªL

ÁÂÁ jsc0518 «e½úµoªí¦¹¥DÃD»P½d¨Ò
ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
¥H¤U¾Ç²ß«e½úªºµ{¦¡½X¤ß±o,½Ð«e½ú¦A«ü¾É!

'¤£¤F¸ÑÃD·N¤£¬O°ÝÃD!±N«e½úªºµ{¦¡½X¤@¦æ¦æ¾Ç²ß!´N·|ª¾¹DÃD·N!
'¦]¬°«á¾Ç¤£¬O­n¸Ñµª!¬O¾Ç²ß!

Option Explicit
Sub test_1()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
'¡ô«Å§iÅܼÆ
[02!g:i].ClearContents '¤£²Ö­p, ³o­n¥ý²MªÅ
'¡ô¦W¬°"02"ªº¤u§@ªí(¥H¤UºÙ:ªí¤G) G:IÄæ²M°£¤º®e
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD ¬O¦r¨å
Arr = Range([01!a1], [01!c65536].End(3))
'¡ô¥OArr ¬O°}¦C!­Ë¤J ¦W¬°"01"¤u§@ªí(¥H¤UºÙ:ªí¤@),
'ªí¤@[A1]¨ìCÄæ³Ì«á¦³¤º®eªº³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ°Ï°ìªº­È

ReDim Brr(1 To UBound(Arr), 1 To 3)
'¡ô«Å§iBrr°}¦Cªº½d³ò! Áa¦V±q1¨ì Arr°}¦CÁa¦V³Ì¤j¦C¸¹,¾î¦V±q1¨ì3
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é±q2¨ì Arr°}¦CÁa¦V³Ì¤j¦C¸¹
    T = Arr(i, 2) & "|" & Arr(i, 3)
    '¡ô¥OT¦r¦êÅÜ¼Æ ¬O°j°é¦C²Ä¤GÄæArr°}¦C¦ì¸mªº­È³s±µ "|" ²Å¸¹,
    '¦A³s±µ °j°é¦C²Ä¤TÄæArr°}¦C¦ì¸mªº­È,(¥H¤UºÙ:®Æ¸¹|§å¸¹)

    T1 = Arr(i, 1) & "|" & T
    '¡ô¥OT1¦r¦êÅÜ¼Æ ¬O°j°é¦C²Ä¤@ÄæArr°}¦C¦ì¸mªº­È³s±µ "|" ²Å¸¹,
    '¦A³s±µ TÅÜ¼Æ (¥H¤UºÙ: ¤é´Á|®Æ¸¹|§å¸¹)

    m = xD(T)
    '¡ô¥Om¼Æ¦rÅÜ¼Æ ¬O¦r¨å¸Ì ®Æ¸¹|§å¸¹ ¬°key¹ïÀ³ªºitem
    '¤@¶}©lm¬Oªì©l­È0
    '¦bi=2®É!¨ä¹ê³o¤@¦æµ{¦¡½X¤w°µ¤F¨â¥ó¨Æ
    '1."A123456|R001"³o¦r¦ê¤w¸gÂǥѦ¹¦æµ{¦¡½X§@¬°key,Item¬O¦r¨åªì©l­È Variant
    '2.m=0
   
    '´«­Ó¤è¦¡±Ô­z:¬d¦r¨å¸ÌKEY¬O "A123456|R001"ªºITEM¬O¤°»ò?§ä±o¨ì´N§âitemµ¹m
    '¦pªG¨S³o­Ókey! ´N§â³o¦r¦ê·íkey©ñ¶i¦r¨å¸Ì
   
    '¦pªG¯à­@¤ßªº¸òµÛ¶°j°é²z¸Ñ!´N·|µo²{ m¥u¬O¥h¬d¦r¨å¬Ý ®Æ¸¹|§å¸¹ ¬O¦bBrr°}¦C²Ä´X¦C

   
    xD(T1) = xD(T1) + 1
    '¡ô¥O ¤é´Á|®Æ¸¹|§å¸¹ ¦r¦êÅܼƬ°keyªºitem²Ö¥[1
   
    '¥H«e³£Ä±±o«Ü©_©Ç«e­±µ{¦¡½X¤S¨S¦³³o­ÓÅܼÆ!! ¬°¤°»ò·|¦b³o¸Ì +1 ???
    '­ì¨Ó¬O¥H«e³£¨S¦³Åܼƪì©l­ÈªºÆ[©À!©Ò¥H³£¬Ý¤£À´!
    '¤£¬O«Å¤£«Å§iªº°ÝÃD! ¤£Àˬd«Å§iÅܼÆOption Explicit ,¤£«Å§iµ{¦¡½XÁÙ¬O·|¶]!
    '¥u¬O³Q»{©w¬O³q¥ÎÅܼÆ!¨Ï¥Î³o­ÓÅܼƨӰµ¼Æ¾Ç¹Bºâ,¥L´N¬O¼Æ¦r.....
   
    '¨S¦³¥¿²Î¾Ç²ß,¾q¶wªº¸ê½è´N±q¾Ç²ß¸ò¿ù»~¤¤¨D¶i¨B!
    '¦r¨å¦n¹³¤]¥i¥H«Å§i¥L¥u¸Ë¼Æ¦r©Î¦r¦ê!¦A¾Ç²ß¨ä¥L©«¤l´N¦³¾÷·|¾Ç¨ì¤F!
    'ÁÂÁ½׾Â!ÁÂÁ¦U¦ì«e½ú!

   
   '©Ò¥H xD(T1) = xD(T1) + 1 ¥u¬O¦b½T©w ¤é´Á|®Æ¸¹|§å¸¹ ¬O¤£¬O¥þ·s²Õ¦X!«á¤è±Æ°£­«½Æ!  @2
    If m = 0 Then
    '¡ô¦pªGm¼Æ¦rÅܼƬO0 ??(°j°é¶]¨ì ®Æ¸¹|§å¸¹ ¬O²Ä¤@¦¸¦b¦r¨å¸Ì¬d³okey m¤~·|¬O0)
       n = n + 1
       '¡ô¥On¼Æ¦rÅܼƶ}©l²Ö¥[1  ³o¬O­n©ñBrr°}¦Cµ²ªGªº¦C¦ì,¦p¤U¤è @1¼Ðµù¦ì¸m
        '¤@¶}©lnªì©l­È¬O0
       '³o¬O­n·s¼W¤@µ§ ¥þ·s²Õ¦Xªº ®Æ¸¹|§å¸¹ ©ñBrr°}¦Cµ²ªGªº¦C¦ì

       m = n
       '¡ô¥O m¼Æ¦rÅܼƭÈ=n¼Æ¦rÅܼƭÈ
       'n¬O­nÄ~Äò²Ö¥[!
       '©Ò¥H¤]­n¦³­ÓÅܼÆ,¸Ë²{¦b°j°é ®Æ¸¹|§å¸¹ ©ñBrr°}¦Cµ²ªGªº¦C¦ì ªº¦C¸¹

       xD(T) = n
       '¡ô¥O¥H ®Æ¸¹|§å¸¹ ÅܼƬ°keyªºitem= nÅܼƭÈ
       Brr(n, 1) = Arr(i, 2) '@1
      '¡ô±N°j°é¦C²Ä¤GÄæArr°}¦C¦ì¸mªº­È­Ë¤J Brr°}¦C(n¼Æ¦rÅܼƭȦC,²Ä¤@Äæ)¦ì¸m
       Brr(n, 2) = Arr(i, 3)  '@1
       '¡ô±N°j°é¦C²Ä¤TÄæArr°}¦C¦ì¸mªº­È­Ë¤J Brr°}¦C(n¼Æ¦rÅܼƭȦC,²Ä¤GÄæ)¦ì¸m
    End If
    If xD(T1) = 1 Then '@2
    '¡ô¦pªG ¤é´Á|®Æ¸¹|§å¸¹ ¦r¦êÅܼƬ°keyªºitem µ¥©ó 1
    'ÁöµM«e­± ³£¦³§â ®Æ¸¹|§å¸¹ ©ñBrr°}¦Cµ²ªGªº¦C¦ì ªº¦C¸¹m±a¥X¨Ó!
    '¦ý¬O ¤é´Á|®Æ¸¹|§å¸¹ ¦pªG­«½Æ¤F!³o±ø¥ó¬O¤£·|¦¨¥ßªº!

       Brr(m, 3) = Brr(m, 3) + 1
       '¡ôÅý Brr°}¦C(m¼Æ¦rÅܼƭȦC,²Ä¤TÄæ)¦ì¸mªº­È²Ö¥[1
    End If
   
Next
[02!g1:i1] = [{"®Æ¸¹","§å¸¹","¤Ñ¼Æ"}]
'¡ô¥Oªí¤GÀx¦s®æ[G1:I1]¨Ì§Ç­Ë¤J¼ÐÃD "®Æ¸¹","§å¸¹","¤Ñ¼Æ"
'¤S¾Ç¨ì¤F!¥H«e³£¥u·| [02!G1:I1] = Array("®Æ¸¹", "§å¸¹", "¤Ñ¼Æ")

With [02!g2].Resize(n, 3)
'¡ô¥H¤U¬OÃö©óªí¤G[G2]Àx¦s®æ¦V¤UÂX®in¦C,¦V¥kÂX®i3Ä檺½d³òÀx¦s®æ(¥H¤UºÙ:µ²ªG®æ)
     .Value = Brr
     '¡ô§âBrr°}¦Cªº­È­Ë¤Jµ²ªG®æ
     .Sort KEY1:=.Item(1), Order1:=1, _
           Key2:=.Item(2), Order2:=1, Header:=2
     '¡ôµ²ªG®æ°µ±Æ§Ç
     '¥H«e³£¥H¬°¬O«ü©w­þ¤@Àx¦s®æ°µKEY1:,«ü©w­þ¤@Àx¦s®æ°µKEY2:
     '­ì¨Ó¬O§ì±Æ§ÇÀx¦s®æªºÄæ¦ì¦Ó¤w

End With
End Sub
Sub ¤G¼h¦¸_º¥¼W±Æ§Ç()
Dim xA
Set xA = [G2:I7]
xA.Sort _
KEY1:=xA.Item(1), Order1:=xlAscending, _
Key2:=xA.Item(2), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub

TOP

¦^´_ 21# ML089
Dear ML089,
§Ú­×§ï¤FÀx¦s®æ®æ¦¡«á¡A¦A®M¥Î§Aªº¤½¦¡¡A´NOK¤F¡C
Just do it.

TOP

¦^´_ 9# jsc0518

¥Î§A­ì¨ÓªºÀÉ®×´ú¸Õ¬OOKªº¡A¸Ì­±¤]¦³2¤Ñ­«½Æ¥u­pºâ1¦¸
¦³·sªº´ú¸ÕÀɮ׶Ü?§Ú¬Ý¬Ý¸U´£¦b­þ¸Ì?
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 18# ­ã´£³¡ªL
Dear ­ã´£³¡ªL,
·PÁ§Aªº¼ö¤ß¦^´_»P±Ð¾É¼Ú
Test OK. ¤j·PÁ¡I¡I
Just do it.

TOP

¦^´_ 17# samwang
Dear samwang,
´ú¸ÕOK¡A·P®¦§Aªº¤jÀ°¦£¡I
Just do it.

TOP

¦^´_ 16# jsc0518


Sub test_1()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
[02!g:i].ClearContents '¤£²Ö­p, ³o­n¥ý²MªÅ
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([01!a1], [01!c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|" & Arr(i, 3)
    T1 = Arr(i, 1) & "|" & T
    m = xD(T): xD(T1) = xD(T1) + 1
    If m = 0 Then
       n = n + 1: m = n: xD(T) = n
       Brr(n, 1) = Arr(i, 2): Brr(n, 2) = Arr(i, 3)
    End If
    If xD(T1) = 1 Then Brr(m, 3) = Brr(m, 3) + 1
Next
[02!g1:i1] = [{"®Æ¸¹","§å¸¹","¤Ñ¼Æ"}]
With [02!g2].Resize(n, 3)
     .Value = Brr
     .Sort Key1:=.Item(1), Order1:=1, _
           Key2:=.Item(2), Order2:=1, Header:=2
End With
End Sub

TOP

¦^´_ 16# jsc0518

2021/1/31  A123456  R001   ---> ³o¨Ç§Ú³£³]©w¦P¤@¤é´Á(¦h¦C)
²Î­pªº¼Æ¶q¤SÅܦ¨¬O¥X²{"Á`"¦¸¼Æ
>> ¤£¦n·N«ä¡A§ó·s¦p¬õ¦r¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test2()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([01!a1], [01!c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|" & Arr(i, 3)
    T1 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
    If xD.Exists(T) Then
        m = xD(T)
        If Not xD.Exists(T1) Then Brr(m, 3) = Brr(m, 3) + 1: xD(T1) = n
    Else
        n = n + 1: xD(T) = n: xD(T1) = n
        Brr(n, 1) = Arr(i, 2)
        Brr(n, 2) = Arr(i, 3)
        Brr(n, 3) = 1
    End If
Next

With Sheets("02").Range("g2").Resize(n, 3)
    .Value = Brr
    .Sort Key1:=.Item(1), Order1:=1, _
          Key2:=.Item(2), Order2:=1, Header:=2
End With
End Sub   

TOP

¦^´_ 14# samwang
Dear samwang,
§Ú¦b¸Õrun¤F»yªk¡Aµo²{
¦b01¤u§@ªí¦A¦¸·s¼W¸ê®Æ
2021/1/31  A123456  R001   ---> ³o¨Ç§Ú³£³]©w¦P¤@¤é´Á(¦h¦C)
²Î­pªº¼Æ¶q¤SÅܦ¨¬O¥X²{"Á`"¦¸¼Æ
¦p°ÊºAÀÉ®×¾Þ§@
12333.gif
Just do it.

TOP

¦^´_ 14# samwang
Dear samwang,
ÁÂÁ§AªºÀ°¦£Åo!§A©Ò´£¨Ñªºªþ¥óÀÉ®×¥i¥H¥Î¡A§Ú¦bcheck§Úªºexcel­þ¸Ì¦³°ÝÃD
·P®¦·P®¦¡I:)
Just do it.

TOP

        ÀR«ä¦Û¦b : ¯¸¦b¥b¸ô¡A¤ñ¨«¨ì¥Ø¼Ð§ó¨¯­W¡C
ªð¦^¦Cªí ¤W¤@¥DÃD