Scripting.DictionaryªºÀ³¥Î 02
- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2023-9-21
|
¦^´_ 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 |
|
|
|
|
|
|
- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2023-9-21
|
¦^´_ 3# john2006168
¤£¦n·N«ä¡A¤£¤Ó¯à²z¸Ñ§Aªº»Ý¨D¡A½Ð¦A¸Ô²Ó»¡©ú¤@¤U¡AÁÂÁ |
|
|
|
|
|
|
- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2023-9-21
|
¦^´_ 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 |
|
|
|
|
|
|