下面是我目前正在使用的代码的修改版本(我在 Stack Exchange 上找到)-
Option Explicit
Sub Main()
Columns("E:E").NumberFormat = "@"
Dim i As Long, c As Long, r As Range, v As Variant
For i = 2 To Range("E" & Rows.Count).End(xlUp).Row
v = Split(Range("E" & i), " ")
c = c + UBound(v) + 1
Next i
For i = 2 To c
Set r = Range("E" & i)
Dim arr As Variant
arr = Split(r, " ")
Dim j As Long
r = arr(0)
For j = 1 To UBound(arr)
Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
r.Offset(j, 0) = arr(j)
r.Offset(j, -1) = r.Offset(0, -1)
r.Offset(j, -2) = r.Offset(0, -2)
r.Offset(j, -3) = r.Offset(0, -3)
r.Offset(j, 1) = r.Offset(0, 1)
r.Offset(j, 2) = r.Offset(0, 2)
r.Offset(j, 3) = r.Offset(0, 3)
r.Offset(j, 4) = r.Offset(0, 4)
Next j
Next i
End Sub
现在此代码的问题是它给我一个错误(下标超出范围)错误 9。
解释一下我想做什么:我在单个单元格中有多个数据,我想将它们拆分成单独的行。现在此代码运行良好,但代码不会在整个工作表中运行,而是会停在几个条目上。
要查看示例:请点击链接了解代码的作用。(https://stackoverflow.com/questions/19815321/text-to-rows-vba-excel)——抱歉,我没有足够的积分来添加图片。
请理解我对此很陌生,大部分都不知道自己在做什么。
谢谢。
答案1
只有当范围为空时它才会中断 - 所以我添加了一个if
Option Explicit
Sub Main()
Columns("E:E").NumberFormat = "@"
Dim i As Long, c As Long, r As Range, v As Variant
For i = 2 To Range("E" & Rows.Count).End(xlUp).Row
v = Split(Range("E" & i), " ")
c = c + UBound(v) + 1
Next i
For i = 2 To c
If Range("E" & i) <> "" Then
Set r = Range("E" & i)
Dim arr As Variant
arr = Split(r, " ")
Dim j As Long
r = arr(0)
For j = 1 To UBound(arr)
Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
r.Offset(j, 0) = arr(j)
r.Offset(j, -1) = r.Offset(0, -1)
r.Offset(j, -2) = r.Offset(0, -2)
r.Offset(j, -3) = r.Offset(0, -3)
r.Offset(j, 1) = r.Offset(0, 1)
r.Offset(j, 2) = r.Offset(0, 2)
r.Offset(j, 3) = r.Offset(0, 3)
r.Offset(j, 4) = r.Offset(0, 4)
Next j
End If
Next i
End Sub
那么,您的数据中一定有一些双空格,它们会断开吗?或者 E 列中最终会留有空白。
您可以使用此代码片段删除 E 列中的多余空格(我的错)
Sub test()
Dim c As Range
Dim lastrow As Integer
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
Dim strValue As String
For Each c In Range("E2:E" & lastrow)
strValue = c.Value
Do While InStr(1, strValue, " ")
strValue = Replace(strValue, " ", " ")
Loop
c = strValue
Next
End Sub