Scripting.DictionaryªºÀ³¥Î 02

john2006168

¦Ñ®v,·Q°Ý¤@¤UScripting.Dictionary¬O§_¥i¥H¥Î¦b¤U¦C±¡ªp,½Ð°Ý­n¨Ä»ò¼g?
·Q­nsheets("Summary")ªºµ²ªG-----sheets"PL"±N¼Æ¶q°£©ó½c¼Æ,¨ä¥L¸ê®Æ¤£ÅÜ,copy ¨ìsummary.

TEST2 (2).zip (13.93 KB)

¤U¸ü¦¸¼Æ: 10

2021-6-1 14:31

¤U¸ü (8.46 KB)

2021-6-1 14:23

¤U¸ü (11.16 KB)

2021-6-1 14:24

samwang

¦^´_ 1# john2006168

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

Sub test()
Dim Arr, xD, T, T1, T2, T0%, i&, M%, N%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([PL!E1], [PL!A65536].End(3))
For i = 1 To UBound(Arr)
    T = Arr(i, 2): T1 = Arr(i, 3): T2 = Arr(i, 4)
    If xD.Exists(T & "") Then
        M = xD(T & "")
        If InStr(Arr(M, 5), "~") Then
            T0 = Split(Arr(M, 5), "~")(1)
        Else
            T0 = Arr(M, 5)
        End If
        If Arr(i, 5) = T0 + 1 Then
            Arr(M, 3) = Arr(M, 3) + T1
            Arr(M, 4) = Arr(M, 4) + T2
            Arr(M, 5) = Split(Arr(M, 5), "~")(0) & "~" & Arr(i, 5)
        Else
            GoTo 99
        End If
    Else
99:     N = N + 1: xD(T & "") = N
        For j = 1 To 5: Arr(N, j) = Arr(i, j): Next
    End If
Next
Sheets("Summary").[A1].Resize(N, 5) = Arr
End Sub

john2006168

¦^´_ 2# samwang

ÁÂÁ¦ѮvÀ°¦£,¥t¥~·Q°Ý¤@¤U,¦pªG§Úsummary¦³¤F¸ê®Æ,·Q­nPLªºµ²ªG,½Ð°Ý­n«ç»ò¼g

¤U¸ü (11.16 KB)

2021-6-2 14:55

.

samwang

¦^´_ 3# john2006168


¤£¦n·N«ä¡A¤£¤Ó¯à²z¸Ñ§Aªº»Ý¨D¡A½Ð¦A¸Ô²Ó»¡©ú¤@¤U¡AÁÂÁÂ

john2006168

¦^´_ 4# samwang
¤£¦n·N«ä,¨Æ¥ó¬Osheet"Summary"²{¦³¸ê®Æ,¼Æ¶q°£©ó¥ó¼Æ«á,±N¥¦¤À¶}¨C¤@­Ó¶µ¥Ø¨ìsheet "PL",(±ø¥ó¬O¼Æ¶q°£©ó¥ó¼Æ)

samwang

¦^´_ 5# john2006168

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

Sub test2()
Dim Arr, Brr(1 To 10000, 1 To 5), T1, T2, T3, T4
Arr = Range([Summary!E1], [Summary!A65536].End(3))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1): T2 = Arr(i, 2): T3 = Arr(i, 3): T4 = Arr(i, 4)
    For i2 = 1 To T4
        N = N + 1: Brr(N, 1) = T1: Brr(N, 2) = T2
        Brr(N, 3) = T3 / T4: Brr(N, 4) = 1: Brr(N, 5) = N
    Next
Next
Sheets("Summary").[A1:E1].Copy Sheets("PL").[A1]
Sheets("PL").[a2].Resize(N, 5) = Brr
End Sub

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú

«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

¸ê®Æªí:

¤U¸ü (31.7 KB)

2023-6-20 13:10

µ²ªGªí°õ¦æ«e:

¤U¸ü (40.11 KB)

2023-6-20 13:10

°õ¦æµ²ªG:

¤U¸ü (64.73 KB)

2023-6-20 13:11

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Z, A, i&, j%, R&, Y&, N&
Sheets("PL").UsedRange.ClearContents
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([Summary!E1], [Summary!A65536].End(3))
For i = 2 To UBound(Brr)
   A = Replace(Brr(i, 5), "~", "-"): A = A & "-" & A
   A = Split(A, "-")(0) & "-" & Split(A, "-")(1)
   R = Abs(Evaluate(A))
   For Y = 0 To R
      If Z(Val(A) + Y) <> "" Then
         MsgBox "½c¸¹­«½Æ: " & Val(A) + Y & " ­×¥¿«á¦A°õ¦æ!"
         Exit Sub
      End If
      Z(Val(A) + Y) = i & "*0+" & Val(Brr(i, 3)) & "/" & (R + 1)
   Next
Next
ReDim Crr(1 To Z.Count + 1, 1 To 6)
For Each A In Z.keys
   If N = 0 Then
      N = 1: Crr(N, 6) = "Remark"
      For j = 1 To 5: Crr(N, j) = Brr(1, j): Next
   End If
   N = N + 1
   Crr(N, 1) = Brr(Val(Z(A)), 1)
   Crr(N, 2) = Brr(Val(Z(A)), 2)
   Crr(N, 3) = Evaluate(Z(A))
   Crr(N, 4) = 1
   Crr(N, 5) = A
   Crr(N, 6) = Brr(Val(Z(A)), 5)
Next
With [PL!A1].Resize(Z.Count + 1, 6)
   .Value = Crr
   .Sort KEY1:=.Item(5), Order1:=1, Header:=1
End With
Set Z = Nothing: Erase Brr, Crr
End Sub

mdr0465

¦^´_ 7# Andy2483


  Andy ®v¥S,±z¦n

«á¾Ç¦bµ{¦¡¤¤¦³¤@ÂI¤£©ú¥Õ·Q¦V§A½Ð±Ð,

A = Split(A, "-")(0) & "-" & Split(A, "-")(1)

¦b¥H¤W»y¥y¤¤ªº¬õ¦â¦r(0) / (1) ¬O¥Nªí¤°»ò·N«ä©O?¦b¾Ç²ß¤WÀ³«ç¼Ë¹B¥Î©O?

½Ð«ü±Ð,ÁÂÁÂ

Andy2483

¦^´_ 8# mdr0465


    ÁÂÁ mdr0465¦^´_,ÁÂÁ¤@°_¾Ç²ß
«á¾ÇºÉ¥i¯àªí¹F©Ò¾Çªº¤ß±o,¤ß±o¦p¤U:
   A = Split(A, "-")(0) & "-" & Split(A, "-")(1)
  '³o¸Ìªº(0)¬O«üA¦r¦ê¥H"-"²Å¸¹¤À³Î¦¨¬°¤@ºû°}¦C¯Á¤Þ¸¹
   '¥HSplit()¤À³Î¦r¦ê«áªº¤@ºû°}¦C¯Á¤Þ¸¹±q0¶}©l
   'Split()(0),Split()(1),Split()(2)...¨Ì¦¹Ãþ±À
   '¦]¬°½c¸¹ ¦³³æ½c¸¹(6,7),©Î°Ï¶¡½c¸¹(2~5,9~10),©Ò¥H¥Î¦¹ªk¥i¤@¨Ö³B²z
   '³o¤èªk¬O¾Ç²ß¦Û ­ã´£³¡ªL«e½ú«ü¾Éªº¤U¦C³sµ²©«,½Ð°Ñ¦Ò
   http://forum.twbts.com/viewthrea ... mp;page=1#pid121027

Sub TEST_2()
Dim A$, B$
A = "7"
B = "9-10"
B = B & "-" & B
MsgBox B
B = Split(B, "-")(0) & "-" & Split(B, "-")(1)
MsgBox B
MsgBox Abs(Evaluate(B))

A = A & "-" & A
MsgBox A
A = Split(A, "-")(0) & "-" & Split(A, "-")(1)
MsgBox A
MsgBox Abs(Evaluate(A))
End Sub

'==================================
¸É¥R:
¦pªG±NA,BÅܼƳ]¬°³q¥Î«¬ÅܼÆ,´N¥i¥HÅý¦r¦ê»P¤@ºû°}¦C³£¥i¥H³Q¸Ë²±
Sub TEST_3()
Dim A, B
A = "7"
B = "9-10"
B = B & "-" & B
MsgBox B
B = Split(B, "-")
B = B(0) & "-" & B(1)
MsgBox B
MsgBox Abs(Evaluate(B))

A = A & "-" & A
MsgBox A
A = Split(A, "-")
A = A(0) & "-" & A(1)
MsgBox A
MsgBox Abs(Evaluate(A))
End Sub

¦Ü©ó«ç»ò¹B¥Î? «Øij¦h½m²ß¦UºØ½d¨Ò±¡¹Ò
«Øij«e½ú¦h¤W½×¾Âµoªí¬Ýªk.¤ß±o...°µ¥æ¬y,¹F¨ì °ª¤¤¥Íµ¥¯Å,¥i·j´M¤º¤å,¦³¶W¦hªº½d¨Òª¾ÃÑ¥i¾Ç²ß»P½m²ß

¤U¸ü (147.64 KB)

2023-7-6 14:06

mdr0465

¦^´_ 9# Andy2483


Andy ®v¥S,
ÁÂÁ§A¸Ô²Óªº¸Ñµª, §Ú·|¦h¤W½×¾Â¦h¾Ç²ß,

¸U¤À·PÁ§A