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

[¤À¨É] §PÂ_¥X²{¤£¦P§å¸¹´X¦¸

¥»©«³Ì«á¥Ñ jsc0518 ©ó 2021-6-17 21:39 ½s¿è

¦^´_ 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¹Ï
001.jpg
2021-6-17 21:35



002.jpg
2021-6-17 21:35



Excel_VBA V2.rar (15.75 KB)
Just do it.

TOP

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

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-6-18 07:49 ½s¿è

¦^´_ 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

TOP

¥»©«³Ì«á¥Ñ jsc0518 ©ó 2021-6-18 10:16 ½s¿è

¦^´_ 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

Noname.jpg
2021-6-18 10:15



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

TOP

¦^´_ 14# jsc0518

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

´¡¤J-->¼Ò²Õ-->µ{¦¡
Â^¨ú.PNG

TOP

¦^´_ 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

TOP

¦^´_ 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
Just do it.

TOP

¦^´_ 17# jsc0518


µL®t§O¡A¥u¬O¼gªk­nª`·N¡AÁÂÁÂ

¨Ò¦p:
¤u§@ªí1¼Ò²Õ: Range("A1")
¤@¯ë¼Ò²Õ:       Sheets("¤u§@ªí1").Range("A1")

TOP

¦^´_ 18# samwang
ª¾¹D¤F¡AÁÂÁ±zªº±Ð¾É¡C
Just do it.

TOP

Sub TEST_A1()
Dim Arr, xD, T$, TT$, i&, j%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([ú®w¶q!e1], [ú®w¶q!y65536].End(3))
For i = 2 To UBound(Arr)
     T = Arr(i, 1): TT = T & "|" & Arr(i, 2)
     xD(TT) = xD(TT) + 1
     If xD(TT) = 1 Then xD(T & "/1") = xD(T & "/1") + 1
     xD(T & "/2") = xD(T & "/2") + Arr(i, 21)
Next
Arr = Range([Analysis!b1], [Analysis!a65536].End(3))
For i = 2 To UBound(Arr)
    For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
Next
[Analysis!b2].Resize(UBound(Arr) - 1, 2) = Arr
End Sub

TOP

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