VBA将句子列转换为单个单词列

时间:2013-12-26 10:02:31

标签: excel excel-vba vba

我遇到了一个小问题,因为你可能看到我不是VBA的主人。 我的设置输入如下(全部在一列中,更长):

  1. 很高兴认识你。
  2. 很高兴见到你。
  3. 你叫什么名字?
  4. 我的名字是杰克 .....
  5. 因此我正在寻找:

    1. 尼斯
    2. 满足
    3. 你。
    4. 尼斯
    5. 满足
    6. 什么
    7. 您的
    8. 名字?

    9. ...
    10. 完美的重新分配将每个句子分成唯一的单词而没有列表中的标点符号。

      我到目前为止的代码是:

      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
      

      它似乎有效,但它会覆盖细胞。你能帮我吗?

1 个答案:

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

希望这有帮助!

<强>截图:

enter image description here