Sub test()
Dim Arr, a
Arr = Range([A1], [A65536].End(3))
For i = 1 To UBound(Arr)
a = Split(Arr(i, 1), Chr(10))
For j = 0 To UBound(a)
Cells(i, 3 + j) = Split(a(j), ")")(1)
Next
Next
End Sub作者: hcm19522 時間: 2021-7-5 10:26
Sub test2()
Dim Arr, a
Arr = Range([A1], [A65536].End(3))
For i =2 To UBound(Arr)
a = Split(Arr(i, 1), Chr(10))
For j = 0 To UBound(a)
Cells(i, 3 + j) = Split(a(j), ")")(1)
Next
Next
End Sub作者: jsc0518 時間: 2021-7-5 14:10
Sub test3()
Dim Arr, a
Arr = Range([A1], [A65536].End(3))
For i = 2 To UBound(Arr)
a = Split(Arr(i, 1), Chr(10))
For j = 0 To UBound(a)
Cells(i, 3 + j) = Split(a(j), "-")(1)
Next
Next
End Sub作者: jsc0518 時間: 2021-7-5 21:02
Sub test()
Dim Arr, a
Arr = Range([C1], [C65536].End(3))
For i = 2 To UBound(Arr)
a = Split(Arr(i, 1), Chr(10))
k = 0
For j = 0 To UBound(a)
Cells(i, 5 + j + k) = Split(a(j), "-")(1)
k = k + 1
Next
Next
End Sub作者: jsc0518 時間: 2021-7-6 17:40
Option Explicit
Sub TEST()
Dim Brr, Crr, Z, N&, M&, i&
'↑宣告變數
Brr = Range([A1], [A65536].End(3))
'↑令Brr變數是二維陣列,以A欄儲存格值帶入
ReDim Crr(1 To UBound(Brr), 1 To 1000)
'↑宣告Crr變數是二為空陣列,縱向範圍同Brr陣列,橫向範圍從1 到1000
For i = 1 To UBound(Brr)
'↑設順迴圈
If Brr(i, 1) = "" Then GoTo i01
'↑如果陣列值是空的!就跳到標示 i01位置繼續執行
N = 0
'↑令N變數歸零
For Each Z In Split(Brr(i, 1), vbLf)
'↑設逐項迴圈!令Z變數是字串被跳行字元分割成的一維陣列子
N = N + 1
'↑令N變數累加 1
If Z = "" Then GoTo z01
'↑如果Z變數是空的!就跳到標示z01位置繼續執行
If InStr(Z, "-") Then
'↑如果Z變數裡有包含"-"字元?
Crr(i, (N - 1) * 2 + 1) = Split(Z, "-")(1)
'↑令Z變數將"-"字元右方的字串寫入 Crr陣列
Else
Crr(i, (N - 1) * 2 + 1) = Z
'↑否則就令 Z變數字串寫入 Crr陣列
End If
If N > M Then M = N
'↑探測Crr陣列橫向需要多少欄數
z01: Next
i01: Next
With [H1].Resize(UBound(Crr), (M - 1) * 2 + 1)
.EntireColumn.ClearContents
'↑將結果欄舊資料清除
.Value = Crr
'↑令Crr陣列值帶入儲存格
End With
Erase Brr, Crr
'↑釋放變數
End Sub