修改VBA代码：删除文本第5个空格后的内容并处理工作表数据

原代码功能是删除首个空格后的所有内容，现在调整为删除第5个空格之后的所有内容（即保留前6个词，对应示例中的处理结果），同时保留原代码直接修改Sheet1单元格、输出去重结果到Sheet2的功能。

修改后的完整代码 #

Sub Test()
 Dim X As Long, Obj As Object
 Dim Data As Variant, Results As Variant, ObjKeys() As String
 Application.ScreenUpdating = False
 ' 读取Sheet1中H列从H2开始的所有数据
 Data = Sheet1.Range("H2", Sheet1.Cells(Sheet1.Rows.Count, "H").End(xlUp)).Value
 
 For X = 1 To UBound(Data)
   ' 关键修改：找到第6个空格的位置，保留该位置之前的内容
   Data(X, 1) = GetLeftUntilNthSpace(Data(X, 1), 6)
 Next
 
 ' 用字典去重
 Set Obj = CreateObject("Scripting.Dictionary")
 For X = 1 To UBound(Data)
   Obj.Item(CStr(Data(X, 1))) = 1
 Next
 
 ' 整理去重后的结果
 ObjKeys = Obj.keys
 ReDim Results(1 To UBound(ObjKeys) + 1, 1 To 1)
 For X = 0 To UBound(ObjKeys)
   Results(X + 1, 1) = ObjKeys(X)
 Next
 
 ' 将处理后的数据写回Sheet1的H列
 Sheet1.Range("H2").Resize(UBound(Data)) = Data
 ' 将表头和去重结果写入Sheet2的J列
 Sheet2.Range("J1").Value = Sheet1.Range("H1").Value
 Sheet2.Range("J2").Resize(UBound(Results)) = Results
 
 Application.ScreenUpdating = True
End Sub

' 自定义函数：返回文本中第N个空格之前的内容（若空格不足N个则返回原文本）
Function GetLeftUntilNthSpace(text As String, n As Integer) As String
 Dim pos As Integer, count As Integer
 pos = 0
 count = 0
 
 Do While count < n And pos > -1
   pos = InStr(pos + 1, text, " ")
   If pos > 0 Then count = count + 1
 Loop
 
 If count = n Then
   GetLeftUntilNthSpace = Left(text, pos - 1)
 Else
   GetLeftUntilNthSpace = text
 End If
End Function

关键修改说明 #

• 新增自定义函数GetLeftUntilNthSpace，专门定位第N个空格的位置，返回该位置之前的文本；如果文本空格数量不足N个，直接返回原文本避免出错。
• 替换原代码中提取首个空格前内容的逻辑，改为调用GetLeftUntilNthSpace(Data(X, 1), 6)——传入6是因为示例需要保留到第6个词（对应第5个空格后的首个词），匹配需求中的处理效果。
• 明确指定工作表对象（Sheet1、Sheet2），避免因当前活动工作表变化导致错误。

用法说明 #

1. 打开Excel文件，按Alt + F11打开VBA编辑器。
2. 插入新模块，粘贴上述代码。
3. 返回Excel界面，按Alt + F8选择Test宏执行：
   • Sheet1的H列（从H2开始）会直接更新为处理后的内容。
   • Sheet2的J列会写入H列表头，以及处理后内容的去重结果。

内容的提问来源于stack exchange，提问作者yend84