samwang

回復 1# john2006168

請測試看看，謝謝

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

samwang

回復 3# john2006168


不好意思，不太能理解你的需求，請再詳細說明一下，謝謝

samwang

回復 5# john2006168

請測試看看，謝謝。

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