一种方法是首先在内存中组装一个数组,然后在一行代码中传输它。第一个函数MultiSplit
假定每行包含相同数量的元素。第二个函数MultiSplit2
放弃了这个假设(以更多处理为代价)。使用符合您的情况的版本。
Function MultiSplit(s As String, d1 As String, d2 As String) As Variant
'd1 is column delimiter, d2 is row delimiter
'returns an array
Dim m As Long, n As Long, i As Long, j As Long
Dim tempRows As Variant, tempRow As Variant
Dim retA As Variant 'return array
tempRows = Split(s, d2)
m = UBound(tempRows)
If Len(tempRows(m)) = 0 Then 'original string ends with a delimiter
m = m - 1
ReDim Preserve tempRows(m)
End If
tempRow = Split(tempRows(0), d1)
n = UBound(tempRow)
ReDim retA(1 To m + 1, 1 To n + 1) '1-based more natural for intended ranges
For i = 1 To m + 1
For j = 1 To n + 1
retA(i, j) = tempRow(j - 1)
Next j
If i < m + 1 Then tempRow = Split(tempRows(i - 1), d1) ' next row to process
Next i
MultiSplit = retA
End Function
Sub test()
Dim testString As String, A As Variant, R As Range
testString = "a,b,c,d;e,f,g,h;i,j,k,l"
A = MultiSplit(testString, ",", ";")
Set R = Range(Cells(1, 1), Cells(UBound(A, 1), UBound(A, 2)))
R.Value = A
End Sub
这里是一个可以处理各种长度的行版本:
Function MultiSplit2(s As String, d1 As String, d2 As String) As Variant
'd1 is column delimiter, d2 is row delimiter
'returns an array
Dim m As Long, n As Long, i As Long, j As Long
Dim tempRows As Variant, jaggedArray As Variant
Dim retA As Variant 'return array
tempRows = Split(s, d2)
m = UBound(tempRows)
If Len(tempRows(m)) = 0 Then 'original string ends with a delimiter
m = m - 1
ReDim Preserve tempRows(m)
End If
ReDim jaggedArray(0 To m)
For i = 0 To m
jaggedArray(i) = Split(tempRows(i), d1)
If UBound(jaggedArray(i)) > n Then n = UBound(jaggedArray(i))
Next i
ReDim retA(1 To m + 1, 1 To n + 1) '1-based more natural for intended ranges
For i = 1 To m + 1
For j = 1 To 1 + UBound(jaggedArray(i - 1))
retA(i, j) = jaggedArray(i - 1)(j - 1)
Next j
Next i
MultiSplit2 = retA
End Function
Sub test2()
Dim testString As String, A As Variant, R As Range
testString = "a,b,c;d,e,f,g,h;i;j,k,l,m,n,o,p;"
A = MultiSplit2(testString, ",", ";")
Set R = Range(Cells(1, 1), Cells(UBound(A, 1), UBound(A, 2)))
R.Value = A
End Sub
为了得到一些定时信息,我写了一子,以产生分裂成1000行的字符串和多达100列:
Sub test3()
Dim s As String, A As Variant, R As Range
Dim i As Long, j As Long, start As Double
Dim n As Long
For i = 1 To 1000
n = i Mod 100
For j = 1 To n
s = s & "a" & IIf(j < n, ",", vbCrLf)
Next j
DoEvents 'in case it hangs
Next i
Debug.Print "String has length " & Len(s)
start = Timer
A = MultiSplit2(s, ",", vbCrLf)
Set R = Range(Cells(1, 1), Cells(UBound(A, 1), UBound(A, 2)))
R.Value = A
Debug.Print "Finished in " & Timer - start & " seconds"
End Sub
当我运行它,我得到的输出:
String has length 99990
Finished in 0.09375 seconds
多个单元在技术上是2D阵列也因此可以用'UBound函数()'和'调整尺寸()'进入阵列分成范围的情况下直接循环。 –