如何迭代地从字符串中提取第一个单词

Question

我有一个包含一些名称的导出。这些位于 E 列

我正在尝试迭代地从列的顶部到底部

如果是新名称，则应创建一个新工作表

所有相同的第一个单词都应添加到同一张纸中

E 列的示例可能是： 7-ZIP RAR 解码器 7-ZIP RAR 解码器 7-ZIP RAR 解码器 Adobe Acrobat 和 Reader 任意代码 Adobe Acrobat 和 Reader 任意代码 Adobe Acrobat 和 Reader 任意代码 Adobe Acrobat 和 Reader 任意代码 Adobe Acrobat 和 Reader 任意代码 Adobe Acrobat 和 Reader 任意代码 Adobe 安全更新 Adobe 安全更新 Adobe 安全更新 Adobe 安全更新 Autodesk 桌面应用程序 Autodesk 桌面应用程序 Autodesk 桌面应用程序

Sub robbie()
    Dim K As Long
    Dim r As Range
    Dim v As Variant
    K = 1
    Dim firstWord As String
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Set w1 = Sheets("Export")
    Set w2 = Sheets("Adobe")
    w1.Activate
    For Each r In Intersect(Range("E:E"), ActiveSheet.UsedRange) 
        v = r.Value
        firstWord = Split(v, " ")(0)
        Debug.Print firstWord
        If InStr(v, "firstWord") > 0 Then
            r.Copy w2.Cells(K, 1)
            K = K + 1
        End If
    Next r
End Sub

问题： 当我将确切值从“7-ZIP”更改为“firstWord”时，它会失败并出现以下错误，但 Debug.print 在立即控制台中打印所有正确的名字，就好像 for 循环保持打开状态一样

“运行时错误‘9’： 下标超出范围”

Answer 1

据我了解，您想要这个：

aaa  13    --> should go to a sheet called "aaa"
bbb  42    --> should go to a sheet called "bbb"

所以如果它还不存在，你需要创建一个新表， 然后在那张纸上找到第一个空单元格。 Excel 没有一种“干净”的方法来检查工作表是否 存在 - 所以我们必须假设它存在并捕获错误。

齐心协力，以下应该做到这一点

v = r.Value
firstword = Split(v, " ")(0)
On Error Resume Next
Dim ws as Worksheet
Set ws = Worksheets(firstword)  '' let's assume it's there
If Err.Number > 0 Then     '' no, so create new sheet
  Set ws = Worksheets.Add
  ws.Name = firstword
  ws.Cells(1, 1) = r.Value
  Err.Clear
Else    '' sheet exists already; find highest empty cell
  ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1) = v
End If