Kubi

回復 1# tommy.lin

試看看。
檔案下載：http://ge.tt/2cokpIg1/v/0?c

Kubi

回復 3# tommy.lin


拆解來源為A、B欄，
拆解後寫入C、D欄。
Option Base 1
Sub test()
    Dim arr1, arr2
    Dim brr()
    er = [A65536].End(3).Row
    arr1 = Range("A2:B" & er)
    ActiveSheet.Columns(2).Replace "/", ";"
    arr2 = Range("A2:B" & er)
    For i = 1 To UBound(arr2)
        For j = 0 To UBound(Split(arr2(i, 2), ";"))
            n = n + 1
            ReDim Preserve brr(2, n)
            If j = 0 Then brr(1, n) = arr2(i, 1)
            brr(2, n) = Split(arr2(i, 2), ";")(j)
        Next j
    Next i
    [C2:D65536].ClearContents
    [C2].Resize(UBound(brr, 2), 2) = Application.Transpose(brr)
    Range("A2:B" & er) = arr1
    arr1 = ""
    arr2 = ""
    Erase brr
End Sub

Kubi

回復 6# tommy.lin


資料拆解來源是A & D 欄....
可否請版大附上如#1的圖形，以方便了解所需。

Kubi

回復 8# tommy.lin


檔案下載：http://ge.tt/5PcoXKg1/v/0?c

拆解來源為A～D欄，
拆解後寫入E～I欄。
Option Base 1
Sub test1()
    Dim arr1, arr2
    Dim brr()
    er = [A65536].End(3).Row
    arr1 = Range("A2:D" & er)
    ActiveSheet.Columns(4).Replace "/", ";"
    arr2 = Range("A2:D" & er)
    For i = 1 To UBound(arr2)
        For j = 0 To UBound(Split(arr2(i, 4), ";"))
            n = n + 1
            ReDim Preserve brr(5, n)
            If j = 0 Then
                brr(1, n) = arr2(i, 1)
                brr(2, n) = arr2(i, 2)
                brr(3, n) = arr2(i, 3)
                brr(4, n) = arr2(i, 1)
            End If
            brr(5, n) = Split(arr2(i, 4), ";")(j)
        Next j
    Next i
    [E2:I65536].ClearContents
    [E2].Resize(UBound(brr, 2), 5) = Application.Transpose(brr)
    Range("A2:D" & er) = arr1
    arr1 = ""
    arr2 = ""
    Erase brr
End Sub

Kubi

回復 11# tommy.lin

那就將
brr(4, n) = arr2(i, 1)
移到判斷式之外。
擷取修改部份：
            If j = 0 Then
                brr(1, n) = arr2(i, 1)
                brr(2, n) = arr2(i, 2)
                brr(3, n) = arr2(i, 3)
                brr(4, n) = arr2(i, 1)
            End If
            brr(5, n) = Split(arr2(i, 4), ";")(j)

改成如下：
            If j = 0 Then
                brr(1, n) = arr2(i, 1)
                brr(2, n) = arr2(i, 2)
                brr(3, n) = arr2(i, 3)
            End If
            brr(4, n) = arr2(i, 1)
            brr(5, n) = Split(arr2(i, 4), ";")(j)