我遇到了一个小问题,因为你可能看到我不是VBA的主人。 我的设置输入如下(全部在一列中,更长):
因此我正在寻找:
完美的重新分配将每个句子分成唯一的单词而没有列表中的标点符号。
我到目前为止的代码是:
Sub splitAddress()
Dim strAddress As String
Dim strAddressParts() As String
Dim numParts As Integer
Dim lastRow As Long
Dim rwIndex As Integer
Dim colIndex As Integer
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
For rwIndex = 2 To lastRow
strAddress = Range("C" & rwIndex).Value
strAddressParts = Split(strAddress, " ")
numParts = UBound(strAddressParts) + 1
Range("I2").Resize(numParts).Value = WorksheetFunction.Transpose(strAddressParts)
Next
End Sub
它似乎有效,但它会覆盖细胞。你能帮我吗?
答案 0 :(得分:3)
尝试此操作(对代码进行非常基本的修改)并在以下情况后查看我的屏幕截图:
Sub splitAddress()
Dim strAddress As String
Dim strAddressParts() As String, rStr As String
Dim numParts As Integer
Dim lastRow As Long, lastRowTwo, nextEmptyRow
Dim rwIndex As Integer
Dim colIndex As Integer
Dim Cell As Range
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
For rwIndex = 2 To lastRow
strAddress = Range("C" & rwIndex).Value
strAddressParts = Split(strAddress, " ")
numParts = UBound(strAddressParts) + 1
lastRowTwo = Cells(Rows.Count, 9).End(xlUp).Row
nextEmptyRow = lastRowTwo + 1
Range("I" & nextEmptyRow).Resize(numParts).Value = WorksheetFunction.Transpose(strAddressParts)
Next
lastRowTwo = Cells(Rows.Count, 9).End(xlUp).Row
For Each Cell In Range("I2:I" & lastRowTwo)
rStr = Strip(Cell.Value)
Cell.Value = rStr
Next Cell
End Sub
Function Strip(WeeWoo As String) As String
With CreateObject("vbscript.regexp")
.Pattern = "[^A-Za-z0-9 ]"
.IgnoreCase = True
.Global = True
Strip = .Replace(WeeWoo, "")
End With
End Function
首先,对于循环的每次迭代,您应该定位列I
中的下一个空行。你保持目标I2
,这就是为什么它会覆盖它。你真的很亲密!
现在,我添加了一个RegEx
函数,它将检查新创建的列表并删除所有非字母和非数字。这基本上剥离了所有标点符号和空格的字符串。 ;)
希望这有帮助!
<强>截图:强>