[發問] 請問各位老師，如何使用VBA 拆分儲存格

wsx1130

各位大大可以將A1儲存個內容，使用VBA拆分到對應的名稱依序往下排嗎?

下載 (12.3 KB)

2022-7-23 22:52

samwang

各位大大可以將A1儲存個內容，使用VBA拆分到對應的名稱依序往下排嗎?
wsx1130 發表於 2022-7-23 22:54

請測試看看，謝謝
Sub test()
Dim Arr, Brr(1 To 50000, 1 To 12), Crr, a, i&, j%
Arr = [a1]: Crr = [c1:n1]
a = Split(Arr, Chr(10))
For i = 0 To UBound(a)
    For j = 1 To UBound(Crr, 2)
        If a(i) = "" Then Exit For
        If j = 7 Then Brr(i + 1, j) = Replace((Split(Split(a(i), Crr(1, j))(1), "T")(0)), " ", ""): GoTo 99
        If j = 11 Then Brr(i + 1, j) = Replace((Split(Split(a(i), Crr(1, j))(1), "E")(0)), " ", ""): GoTo 99
        If j = 12 Then Brr(i + 1, j) = "END": GoTo 99
        Brr(i + 1, j) = Replace((Split(Split(a(i), Crr(1, j))(1), "[")(0)), " ", "")
99:  Next j
Next i
[c2].Resize(UBound(a) + 1, 12) = Brr
End Sub

Andy2483

回復 1# wsx1130


請測試看看 謝謝

Option Explicit
Sub TEST_1()
Dim Arr, Brr, a, i, j, b
a = Split([A1], Chr(10))
b = Mid([A1], 6, 1)
ReDim Brr(1 To UBound(a), 1 To 12)
For i = 0 To UBound(a) - 1
   Arr = Split(a(i), b)
   For j = 1 To 11
      Brr(i + 1, j) = Arr((j * 2 - 1))
   Next
   Brr(i + 1, 12) = "END"
Next
[C2].Resize(UBound(a), 12) = Brr
End Sub

後輩受益良多!謝謝前輩發表此主題!