VBA将单列转换成单列的列

我遇到了一个小问题,可能你可以看到我不是VBA的主人。 我这样设置input(全部在一列中,更长):

  1. 很高兴见到你。
  2. 我也很高兴见到你。
  3. 你叫什么名字?
  4. 我的名字是杰克。
    …..

因此,我正在寻找:

  1. 尼斯
  2. 遇到
  3. 您。
  4. 尼斯
  5. 遇到
  6. 太。
  7. 什么
  8. 你的
  9. 名称?
  10. 我的

完美的reslut将每个句子分隔成独特的单词,而在列表中没有标点符号。

我到目前为止的代码是:

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 

它似乎在工作,但它覆盖了单元格。 你能帮我么?

试试这个(对代码进行非常基本的修改),然后看看我的屏幕截图:

 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函数,将检查您新创build的列表,并删除所有非字母和非数字。 这基本上剥离了所有标点符号和空格的string。 ;)

希望这可以帮助!

截图:

在这里输入图像说明