Excel-Vba脚本在number + dot char之后在单元格中添加多行

时间:2016-01-05 18:24:09

标签: excel vba excel-vba loops newline

希望你能够帮助我解决一直引起头痛的问题。我是一个新手,为了自己解决这个问题,所以这就是:

有没有办法让VBA遍历列中的所有单元格,并在每个数字+点字符后添加一个空行

单元格中的示例数据: 1. textA2。 textB3。 textC4。 textD5。 textE

脚本后的所需输出:
文字A 2. textB
3. textC
4. textD
5. textE

谢谢大家。

1 个答案:

答案 0 :(得分:0)

希望这能帮到你:

Sub parsingText()
Dim a 'to store the parsed text
Dim t
Dim myAscii As Integer

a = Split(Range("A1"), ".")

For t = 1 To UBound(a)
    myAscii = Asc(Right(a(t), 1)) 'ASCII code of the last char
    If myAscii >= 48 And myAscii <= 57 Then 'the 0-9 numbers are 48-57 ASCII codes
        Cells(t, 2).Value = t & ". " & Left(a(t), Len(a(t)) - Len(t)) 'Take just the text and replace the index counter
    Else
        Cells(t, 2).Value = t & ". " & a(t) 'If the last text has no index (as the 5th)
    End If
Next t

End Sub

注意:在Cells(t, 2).Value我使用B列,您可以抓住任何其他内容。文本ALWAYS具有相同的格式number[.][space][text]

RANGE A1: 1. textA2. textB3. textC4. textD5. textE

结果:

Range B1:   1.  textA
Range B2:   2.  textB
Range B3:   3.  textC
Range B4:   4.  textD
Range B5:   5.  textE

新编辑:正如您在评论中所提出的那样

为源数据添加大范围。

Sub parsingText()
Dim a 'to store the parsed text
Dim t
Dim myAscii As Integer
Dim rng As Range
Dim R

Set rng = Range("A1:A50")

For Each R In rng
    a = Split(R, ".")
    For t = 1 To UBound(a)
        myAscii = Asc(Right(a(t), 1)) 'ASCII code of the last char
        If t = 1 Then
            If myAscii >= 48 And myAscii <= 57 Then 'the 0-9 numbers are 48-57 ASCII codes
                Cells(R.Row, 2).Value = t & ". " & Left(a(t), Len(a(t)) - Len(t))  'Take just the text and replace the index counter
            Else
                Cells(R.Row, 2).Value = t & ". " & a(t) 'If the last text has no index (as the 5th)
            End If
        Else
            If myAscii >= 48 And myAscii <= 57 Then 'the 0-9 numbers are 48-57 ASCII codes
                Cells(R.Row, 2).Value = Cells(1, 2).Value & vbCrLf & t & ". " & Left(a(t), Len(a(t)) - Len(t + 1)) 'Take just the text and replace the index counter
                'Here the update.
            Else
                Cells(R.Row, 2).Value = Cells(1, 2).Value & vbCrLf & t & ". " & a(t) 'If the last text has no index (as the 5th)
            End If
        End If
    Next t
Next R
End Sub