返回列表 上一主題 發帖

[發問] A資料庫依原則轉置B資料庫-問題尋問

Sub TEST()
Dim Arr, Brr, xD, i&, T$, U, a, b, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Sheet1!d1], [Sheet1!a65536].End(3))
For i = 1 To UBound(Arr)
    T = Arr(i, 1) & IIf(Arr(i, 2) = "A01", "", "|")
    xD(T) = Trim(xD(T) & " " & i)
Next i
ReDim Brr(1 To 30000, 1 To 4)
For Each U In xD.keys
    If xD(U & "|") = "" Then GoTo 101
    For Each a In Split(xD(U), " ")
    For Each b In Split(xD(U & "|"), " ")
        N = N + 2
        For i = 1 To 4
            Brr(N - 1, i) = Arr(a, i)
            Brr(N, i) = Arr(b, i)
        Next
    Next
    Next
101: Next
[Sheet2!A1:D1].Resize(N) = Brr
End Sub


=============================

TOP

回復 4# rouber590324


確定有名稱為"Sheet62"的工作表???

TOP

        靜思自在 : 待人退一步,愛人寬一寸,就會活得很快樂。
返回列表 上一主題