Question

我将这些代码用于文本到行的目的，但是我无法在Col B中的特定行数之后将其转换。而对于col c和d来说，它可以正常工作。还有一件事，如果我接下来要删除错误恢复，则我的下标超出范围错误。请帮助我解决这些错误。

给定输入的预期输出：

代码：

Sub Main()
On Error Resume Next
Columns("B:B").NumberFormat = "@"
Dim i As Long, c As Long, r As Range, v As Variant

For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
    v = Split(Range("B" & i), ",")
    c = c + UBound(v) + 1
Next i

For i = 2 To c
    Set r = Range("B" & 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, 1) = r.Offset(0, 1)
    Next j
Next i

Columns("C:C").NumberFormat = "@"
For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
    v = Split(Range("C" & i), ",")
    c = c + UBound(v) + 1
Next i
For i = 2 To c
    Set r = Range("C" & i)
    arr = Split(r, ",")
    r = arr(0)
    For j = 1 To UBound(arr)
    r.Offset(j, 0) = arr(j)
    r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i
Columns("D:D").NumberFormat = "@"
For i = 1 To Range("D" & Rows.Count).End(xlUp).Row
    v = Split(Range("D" & i), ",")
    c = c + UBound(v) + 1
Next i
For i = 2 To c
    Set r = Range("D" & i)

    arr = Split(r, ",")
    r = arr(0)
    For j = 1 To UBound(arr)
    r.Offset(j, 0) = arr(j)
    r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i
Columns("E:E").NumberFormat = "@"

For i = 1 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)

    arr = Split(r, ",")
    r = arr(0)
    For j = 1 To UBound(arr)
    r.Offset(j, 0) = arr(j)
    r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i
End Sub

Answer 1

这是一个有效的代码。

之前：本地小时营业时间 1 10,12 1,2 10,24 BANG，KOL 2 1,2,3 1,2,3 1,4,9 A，B，C

之后：本地小时营业时间 1 10 1 10砰 1 12 2 24 KOL 2 1 1 1 A 2 2 2 4 B 2 3 3 9 C

Option Explicit

Sub Main()

Columns("B:B").NumberFormat = "@"
Dim i As Long, c As Long, r As Range, v As Variant

For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
    v = Split(Range("B" & i), ",")
    c = c + UBound(v) + 1
Next i

For i = 2 To c
    Set r = Range("B" & 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, 1) = r.Offset(0, 1)
    Next j
Next i


Columns("C:C").NumberFormat = "@"
For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
    v = Split(Range("C" & i), ",")
    'c = c + UBound(v) + 1
Next i
For i = 2 To c
    Set r = Range("C" & i)
    arr = Split(r, ",")
    r = arr(0)
    For j = 1 To UBound(arr)
    r.Offset(j, 0) = arr(j)
    r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i
Columns("D:D").NumberFormat = "@"

For i = 1 To Range("D" & Rows.Count).End(xlUp).Row
    v = Split(Range("D" & i), ",")
    'c = c + UBound(v) + 1
Next i
For i = 2 To c
    Set r = Range("D" & i)

    arr = Split(r, ",")
    r = arr(0)
    For j = 1 To UBound(arr)
    r.Offset(j, 0) = arr(j)
    r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i
Columns("E:E").NumberFormat = "@"

For i = 1 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)

    arr = Split(r, ",")
    r = arr(0)
    For j = 1 To UBound(arr)
    r.Offset(j, 0) = arr(j)
    r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i
End Sub

Answer 2

这是一个有效的代码（我想您将结束其他问题的地方，重新发布在这里）：

Option Explicit

Sub SplitByRows()
Dim Col As Long, LastRow As Long, ColParts() As String
Dim i, a, k As Long
Dim StringNo As String
LastRow = Cells(Rows.Count, "B").End(xlUp).Row

For i = 2 To LastRow
    k = CountChrInString(Cells(i, 2).Value, ",")
    StringNo = Cells(i, 1).Value
        For a = 1 To k
            Cells(i, 1).Value = Cells(i, 1).Value & "," & StringNo
        Next a
Next i

For Col = 1 To 5 'Column A to Column C
    ColParts = Split(Join(Application.Transpose(Range(Cells(2, Col), Cells(LastRow, Col))), ","), ",")
    With Cells(2, Col).Resize(UBound(ColParts) + 1)
    .NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
    .Value = Application.Transpose(ColParts)
    End With
Next

End Sub


Public Function CountChrInString(Expression As String, Character As String) As Long

    Dim iResult As Long
    Dim sParts() As String

    sParts = Split(Expression, Character)

    iResult = UBound(sParts, 1)

    If (iResult = -1) Then
    iResult = 0
    End If

    CountChrInString = iResult

End Function

我所做的就是在代码的开头以及第一列中添加一些“，”。

为此，我需要在第二列的单元格中计算“，”的数量。这是通过以下页面中的功能完成的：How to find Number of Occurences of Slash from a strings

之后，您的代码就完成了其余的工作；）

Excel中的文本到行VBA代码错误

2 个答案: