3 列的 SliceNDice
SliceNDice for 3 columns
我喜欢 brettdj 的 SliceNDice 子:
Split comma separated entries to new rows
我一直都在用它。我现在的情况是三列,对于我的生活 - 我无法弄清楚如何更改 vba 以使其工作。第三列将是带有逗号分隔值的列。前两列是单个条目。第一次为我发帖所以我抓着椅子扶手以防我做错了什么。
如果您尝试在每个后续行中保留第一列和第二列,同时在第三列中添加每个分隔值,这应该可行。
Sub SliceNDice()
Dim objRegex As Object
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
'Define the range to be analysed
X = Range([a1], Cells(Rows.Count, "c").End(xlUp)).Value2
ReDim Y(1 To 3, 1 To 1000)
For lngRow = 1 To UBound(X, 1)
'Split each string by ","
tempArr = Split(X(lngRow, 3), ",")
For Each strArr In tempArr
lngCnt = lngCnt + 1
'Add another 1000 records to resorted array every 1000 records
If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
Y(1, lngCnt) = X(lngRow, 1)
Y(2, lngCnt) = X(lngRow, 2)
Y(3, lngCnt) = objRegex.Replace(strArr, "")
Next
Next lngRow
'Dump the re-ordered range to columns C:D
[d1].Resize(lngCnt, 3).Value2 = Application.Transpose(Y)
End Sub
示例数据:
我喜欢 brettdj 的 SliceNDice 子:
Split comma separated entries to new rows
我一直都在用它。我现在的情况是三列,对于我的生活 - 我无法弄清楚如何更改 vba 以使其工作。第三列将是带有逗号分隔值的列。前两列是单个条目。第一次为我发帖所以我抓着椅子扶手以防我做错了什么。
如果您尝试在每个后续行中保留第一列和第二列,同时在第三列中添加每个分隔值,这应该可行。
Sub SliceNDice()
Dim objRegex As Object
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
'Define the range to be analysed
X = Range([a1], Cells(Rows.Count, "c").End(xlUp)).Value2
ReDim Y(1 To 3, 1 To 1000)
For lngRow = 1 To UBound(X, 1)
'Split each string by ","
tempArr = Split(X(lngRow, 3), ",")
For Each strArr In tempArr
lngCnt = lngCnt + 1
'Add another 1000 records to resorted array every 1000 records
If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
Y(1, lngCnt) = X(lngRow, 1)
Y(2, lngCnt) = X(lngRow, 2)
Y(3, lngCnt) = objRegex.Replace(strArr, "")
Next
Next lngRow
'Dump the re-ordered range to columns C:D
[d1].Resize(lngCnt, 3).Value2 = Application.Transpose(Y)
End Sub
示例数据: