希望你能够帮助我解决一直引起头痛的问题。我是一个新手,为了自己解决这个问题,所以这就是:
有没有办法让VBA遍历列中的所有单元格,并在每个数字+点字符后添加一个空行
单元格中的示例数据: 1. textA2。 textB3。 textC4。 textD5。 textE
脚本后的所需输出:
文字A
2. textB
3. textC
4. textD
5. textE
谢谢大家。
答案 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