我從文本檔案中獲取了一些不干凈的資料，在文本檔案中，我根據 VBA 腳本中的資料對其進行處理，得到以下輸出。
這是原始字串。
1* student 1*2018-01-01*1*1234122
2* student 2*2017-01-01*1*54654654234
3* student 3*2015-01-01*4*54234654654
4* student 4*2012-01-01*5*546542345654
我想要不同單元格中的輸出，如下面在 excel 中任何打開的作業表中所述。
| 卷號 | 學生姓名 | 出生日期 | 班級 | 電話 |
|---|---|---|---|---|
| 1 | 學生 1 | 2018-01-01 | 1 | 1234122 |
| 2 | 學生 2 | 2017-01-01 | 1 | 54654654234 |
| 3 | 學生 3 | 2015-01-01 | 4 | 54234654654 |
| 4 | 學生 4 | 2012-01-01 | 5 | 546542345654 |
我嘗試了各種來源，但無法獲得預期的輸出。任何幫助將不勝感激。
uj5u.com熱心網友回復：
請嘗試下一個方法。它假定您顯示的整個文本都在一個單元格中，而不是在不同的亞麻布中。但上述方式也會處理單行：
Sub extractTextDelimSep()
Dim x As String, arr, arrLine, arrFin, cols As Long, i As Long, j As Long
x = "1* student 1*2018-01-01*1*1234122" & vbCr & _
"2* student 2*2017-01-01*1*54654654234" & vbCr & _
"3* student 3*2015-01-01*4*54234654654" & vbCr & _
"4* student 4*2012-01-01*5*546542345654"
arr = Split(x, vbCr) 'split the rows
cols = UBound(Split(arr(0), "*")) 1 'determine the columns number per row
ReDim arrFin(1 To UBound(arr) 1, 1 To cols) 'ReDim the final array
For i = 0 To UBound(arr)
arrLine = Split(Replace(arr(i), " ", ""), "*")
For j = 0 To UBound(arrLine)
arrFin(i 1, j 1) = arrLine(j)
Next j
Next i
Range("B2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
End Sub
而是將x字串用作構建字串，您可以將字串放在單元格中，并且可以使用x = ActiveCell.value.
將上述代碼轉換為函式也很容易......
編輯：
您可以使用下一個功能：
Function extractTextDelimSep(x As String) As Variant
Dim arr, arrLine, arrFin, cols As Long, i As Long, j As Long
arr = Split(x, vbCr)
cols = UBound(Split(arr(0), "*")) 1
ReDim arrFin(1 To UBound(arr) 1, 1 To cols)
For i = 0 To UBound(arr)
arrLine = Split(Replace(arr(i), " ", ""), "*")
For j = 0 To UBound(arrLine)
arrFin(i 1, j 1) = arrLine(j)
Next j
Next i
extractTextDelimSep = arrFin
End Function
如果所有內容都在同一個單元格中（在 A:A 列中），則應按以下方式呼叫它：
Sub TestextractTextDelimSep()
Dim x As String, arr
x = ActiveCell.Value
arr = extractTextDelimSep(x)
'drop the array content at once:
Range("B" & ActiveCell.row).Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub
如果字串分布在（不同）單元格的一行中，您可以使用：
Sub TestextractTextDelimSepRange()
Dim lastR As Long, arr, i As Long
lastR = Range("A" & rows.count).End(xlUp).row
For i = 1 To lastR
arr = extractTextDelimSep(Range("A" & i).Value)
Range("B" & i).Resize(1, UBound(arr, 2)).Value = arr
Next i
End Sub
對于最后一種情況，在 Excel 365 中，它可以用作 UDF 函式，從單元格中作為公式呼叫：
=extractTextDelimSep(A1) 'in A1 should be the line to be split
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/514481.html
標籤：擅长vba