Dim lastRow As Long Dim i As Long Dim arr() As String lastRow = Cells(Rows.Count, "B").End(xlUp).Row For i = 1 To lastRow arr = Split(Cells(i, "B").Value, "-") If UBound(arr) >= 1 Then Cells(i, "B").Value = arr(1) Else Cells(i, "B").Value = "" End If Next i 修改B列中的某一行数据没有"-"符号，那么就将其跳過

你可以在循环中加入一个判断语句，检查字符串中是否包含 "-" 符号。如果不包含，就跳过当前行的处理。

以下是修改后的代码：

Dim lastRow As Long
Dim i As Long
Dim arr() As String

lastRow = Cells(Rows.Count, "B").End(xlUp).Row

For i = 1 To lastRow
    ' 检查字符串中是否包含 "-" 符号
    If InStr(Cells(i, "B").Value, "-") > 0 Then
        arr = Split(Cells(i, "B").Value, "-")
        If UBound(arr) >= 1 Then
            Cells(i, "B").Value = arr(1)
        Else
            Cells(i, "B").Value = ""
        End If
    End If
Next i

相关问题

Sub 流量源MB() Dim sPath As String Dim fso As Object, objmainFolder As Object, objFile As Object Dim n%, t% Dim arr As Variant Application.ScreenUpdating = False With Application.FileDialog(msoFileDialogFolderPicker) .Show If .SelectedItems.Count = 0 Then MsgBox "您没有选择相应路径！", vbInformation + vbOKOnly, "警告" Exit Sub Else sPath = .SelectedItems(1) End If End With Set fso = CreateObject("scripting.filesystemobject") Set objmainFolder = fso.getfolder(sPath) On Error Resume Next tms = Timer For Each objFile In objmainFolder.Files If LCase(Right(objFile.Name, 3)) = "xls" Then With GetObject(objFile.Path) With .Sheets(1) intlastrow = .[a6].CurrentRegion.Rows.Count .Range("ag6:ag1" & intlastrow) = Mid(objFile.Name, 18, 10) arr = .Range("a6:ag1" & intlastrow) End With .Close False End With With Sheets("流量源-MB") .Cells(.Rows.Count, 3).End(xlUp).Offset(1).Resize(UBound(arr), UBound(arr, 2)) = arr End With End If n = n + 1 Next objFile t = t + 1 Set objFolder = Nothing Set fso = Nothing MsgBox "您刚刚汇总了" & t & "个文件夹，总计" & n & "个文件！" & "总耗时" & Int((Timer - tms) / 60) & "分" & ((Timer - tms) Mod 60) & "秒", vbOKOnly, "温馨提示" End Sub

这段代码是一个 VBA（Visual Basic for Applications）宏，用于汇总特定文件夹中的 Excel 文件数据到一个名为 "流量源-MB" 的工作表中。以下是代码的主要步骤：

1. 弹出一个文件夹选择对话框，让用户选择要汇总数据的文件夹。
2. 如果用户未选择文件夹，则显示一个警告消息框并退出宏。
3. 使用文件系统对象 (FileSystemObject) 创建一个对选定文件夹的引用。
4. 遍历选定文件夹中的每个文件。
5. 如果文件是以 ".xls" 结尾，则打开该文件。
6. 在打开的工作簿的第一个工作表中，获取数据区域的最后一行。
7. 将文件名的一部分（第 18 到 27 个字符）写入数据区域的 "AG6:AG" & 最后一行 单元格范围。
8. 将数据区域的值存储在变量 arr 中。
9. 关闭打开的工作簿，而不保存更改。
10. 将 arr 的值写入名为 "流量源-MB" 的工作表中的下一个空行。
11. 计算已处理文件和文件夹的计数。
12. 显示一个消息框，其中包含已处理文件夹和文件的计数以及总耗时。

请注意，这段代码假设目标工作簿中已经存在名为 "流量源-MB" 的工作表。如果该工作表不存在，代码将会引发错误。

请帮我完成一个excel的宏代码，以满足以下需求： 1、表格SHEET1中A列有多个关键词。 2、将整列中每个单元格里重复包含的单词去除，保留没有重复的值，导出到B列。 3、需求例子：假设A列中关键词为：solar lights for outside pathway solar lights for outside solar lights outdoor waterproof solar lights for outside garden solar lights string solar lights for outside motion sensor solar lights outdoor waterproof string 则去除solar lights,导出for outside pathway for outside outdoor waterproof for outside garden string for outside motion sensor outdoor waterproof string到B列同一行中

以下是一个Excel VBA宏代码，可以实现你的需求：

Sub RemoveDuplicates()
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim keywords() As String
    Dim uniqueKeywords() As Variant
    
    ' 获取最后一行
    lastRow = Sheets("SHEET1").Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 遍历每个单元格
    For i = 1 To lastRow
        ' 将关键词拆分为数组
        keywords = Split(Sheets("SHEET1").Cells(i, 1).Value, " ")
        
        ' 初始化唯一关键词数组
        ReDim uniqueKeywords(0 To UBound(keywords))
        
        ' 遍历关键词数组
        For j = LBound(keywords) To UBound(keywords)
            ' 检查关键词是否已存在于唯一关键词数组中
            If Not IsInArray(keywords(j), uniqueKeywords) Then
                ' 将唯一关键词添加到数组中
                uniqueKeywords(j) = keywords(j)
            End If
        Next j
        
        ' 将唯一关键词导出到B列
        Sheets("SHEET1").Cells(i, 2).Value = Join(uniqueKeywords, " ")
    Next i
End Sub

Function IsInArray(keyword As String, arr() As Variant) As Boolean
    Dim element As Variant
    
    ' 遍历数组中的每个元素
    For Each element In arr
        ' 检查元素是否与关键词相等
        If element = keyword Then
            IsInArray = True
            Exit Function
        End If
    Next element
    
    IsInArray = False
End Function

要在Excel中运行此宏代码，请按照以下步骤操作：

1. 打开Excel文件。
2. 按下`ALT + F11`打开VBA编辑器。
3. 在左侧的项目资源管理器中，双击要在其中添加宏代码的工作簿。
4. 在右侧的代码窗口中，粘贴上面的代码。
5. 关闭VBA编辑器。
6. 在Excel中选择“开发工具”选项卡。
7. 单击“宏”按钮。
8. 选择“RemoveDuplicates”宏并单击“运行”。

这将在SHEET1的A列中进行操作，并将结果导出到B列中。请确保在运行宏之前将数据放在正确的工作表中。