jsc0518

¦^´_ 16# samwang

Dear samwang,
¤È¦w¡I±z¦n¡I

¥i¥H¥Î¤F¡A«D±`·PÁ±zªºÀ°¦£¡I

¦A»P±z½Ð±Ð´X­Ó°ÝÃD
1.­n«ç»òª¾¹D¨º¨Ç»yªk(«ü¥O)¬O¨Ï¥Î¦b¼Ò²Õ¡H¨º¨Ç»yªk(«ü¥O)¬O¨Ï¥Î¦b¤u§@ªíªº¡H
2.©ñ¦b¼Ò²Õ©Î¤u§@ªí¡A¥L­Ìªº®t²§¬O¦b­þ¸Ì¡H

¦A³Â·Ð±z±Ð¾É¡AÁÂÁ±z¡I

samwang

¦^´_ 14# jsc0518

µ{¦¡­×§ï¦p¤U¡A­n©ñ¦b¤u§@ªí©Î¼Ò²Õ³£¥i¥H¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C

Sub test5()
Dim Arr, xD, xD1, T1, TT, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
With Sheets("ú®w¶q")
    Arr = .Range(.[e1], .[y65536].End(3))
    For i = 2 To UBound(Arr)
         T1 = Arr(i, 1): TT = Arr(i, 1) & Arr(i, 2)
         If Not xD.Exists(TT) Then
             xD(TT & "") = xD(TT & "") + 1
             xD(T1 & "") = xD(T1 & "") + xD(TT & "")
         End If
         xD1(T1 & "") = xD1(T1 & "") + Arr(i, 21)
    Next
End With
With Sheets("Analysis")
    Arr = .Range(.[b2], .[a65536].End(3))
    For i = 1 To UBound(Arr)
        T1 = Arr(i, 1)
        Arr(i, 1) = xD(T1 & "")
        Arr(i, 2) = xD1(T1 & "")
    Next
    .Range("b2").Resize(UBound(Arr), 2) = Arr
End With
End Sub

samwang

¦^´_ 14# jsc0518

»Ý­n§âµ{¦¡©ñ¦b¼Ò²Õ¸Ì­±¡AÁÂÁÂ

´¡¤J-->¼Ò²Õ-->µ{¦¡

jsc0518

¦^´_ 13# samwang
Dear samwang,
¦­¦w¡I±z¦n¡I
·PÁ±zªºÀ°¦£¡A§Ú§â»yªkCOPY¨Ã°õ¦æ¡A¦ýµo¥Í¤F¿ù»~°T®§¡G400(¦p¤U¹Ï)
¥i¥HÀ°À°§Ú¶Ü¡H ><"
«ô°U±z¤F

¤U¸ü (136.42 KB)

2021-6-18 10:15

Àɮצp¤U
111.rar (25.89 KB)

¤U¸ü¦¸¼Æ: 6

2021-6-18 10:16

samwang

¦^´_ 11# jsc0518

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C

Sub test4()
Dim Arr, xD, xD1, T1, TT, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
Arr = Range([ú®w¶q!e1], [ú®w¶q!y65536].End(3))
For i = 2 To UBound(Arr)
     T1 = Arr(i, 1): TT = Arr(i, 1) & Arr(i, 2)
     If Not xD.Exists(TT) Then
         xD(TT & "") = xD(TT & "") + 1
         xD(T1 & "") = xD(T1 & "") + xD(TT & "")
     End If
     xD1(T1 & "") = xD1(T1 & "") + Arr(i, 21)
Next
With Sheets("Analysis")
    Arr = .Range(.[b2], .[a65536].End(3))
    For i = 1 To UBound(Arr)
        T1 = Arr(i, 1)
        Arr(i, 1) = xD(T1 & "")
        Arr(i, 2) = xD1(T1 & "")
    Next
    .Range("b2").Resize(UBound(Arr), 2) = Arr
End With
End Sub

jsc0518

¦^´_ 8# hcm19522
Dear hcm19522 ±z¦n¡I·PÁ±zªº¼ö¤ß¸Ñµª
¨Ï¥Î¤F¤½¦¡¡ATEST OK¡C¦ý§Úªº¸ê®Æµ§¼Æ¹L¦h¡A»Ýªá¤@ÂI®É¶¡¡C
ÁÂÁ§A¼Ú¡I

jsc0518

¦^´_ 9# samwang
Hi samwang ±z¦n¡I·PÁ±zªº¼ö¤ßÀ°¦£
¸Õ¹L¤FVBA¡A´ú¸ÕOK¡I
·Q»P±z½Ð±Ð¡A­Y¤À°µ¨â­Ó¤u§@ªí¡A¸ê®Æ®wªº³¡¥÷¤u§@ªí¬°"ú®w¶q"¡A¦Ó»Ý¤ÀªR¨C¤@®Æ¸¹¤U¥X²{´X­Ó§å¸¹¤ÎÁ`¼Æ¥[Á`«h©ñ¦b¤u§@ªí¬°"Analysis"
¨ºVBA­n«ç»ò­×­q©O¡H
·P®¦¡I¡I¡I

¦p¤U¹Ï

¤U¸ü (114.34 KB)

2021-6-17 21:35

¤U¸ü (61.75 KB)

2021-6-17 21:35

Excel_VBA V2.rar (15.75 KB)

¤U¸ü¦¸¼Æ: 4

2021-6-17 21:36

jsc0518

¦^´_ 7# aer

Hi ±z¦n¡I·PÁ±zªº¼ö¤ßÀ°¦£¡A
­è­èRUN¤F¤@¤U»yªk¡Aµ²ªG¬O§Ú­nªº¡A¦ý»Ý­n¶]¤@¨Ç®É¶¡(³s¦sÀɮ׳£­n¤@ÂI®É¶¡)¡A§Úªº¸ê®Æ¥Ø«e¬ù¦³2381µ§

samwang

¦^´_ 5# jsc0518

¤£¦n·N«ä¡A¬Ý¤F¨ä¥L¤j¤j¸Ñµª¡A²×©ó¤F¸Ñ±zªº»Ý¨D¤F¡A6¼Óµ{¦¡½Ð©¿²¤¡A¤U­±µ{¦¡½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C

Sub test3()
Dim Arr, xD, xD1, T1, TT, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
Arr = Range([c1], [a65536].End(3))
For i = 2 To UBound(Arr)
     T1 = Arr(i, 1): TT = Arr(i, 1) & Arr(i, 2)
     If Not xD.Exists(TT) Then
         xD(TT & "") = xD(TT & "") + 1
         xD(T1 & "") = xD(T1 & "") + xD(TT & "")
     End If
     xD1(T1 & "") = xD1(T1 & "") + Arr(i, 3)
Next
Arr = Range([g2], [f65536].End(3))
For i = 1 To UBound(Arr)
    T1 = Arr(i, 1)
    Arr(i, 1) = xD(T1 & "")
    Arr(i, 2) = xD1(T1 & "")
Next
Range("g2").Resize(UBound(Arr), 2) = Arr
End Sub

hcm19522

https://blog.xuite.net/hcm19522/twblog/589839401