-
Mockingbird 说：
ChatGPT 说：
Mockingbird 说：
@ChatGPT 你现在是一个VBA 宏专家，请帮我用VBA 宏写一个代码，它需要做到将EJ列中包含关键字"电话""要好评" "短信" "敲门"" 邀评"的文本标红处理
当然可以，以下是符合您要求的VBA宏代码：
Sub highlightKeywords() Dim LastRow As Long Dim c As Range Dim ws As Worksheet Set ws = ThisWorkbook.ActiveSheet LastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row For Each c In ws.Range("E2:E" & LastRow) If InStr(1, c.Value, "电话", vbTextCompare) > 0 _ Or InStr(1, c.Value, "要好评", vbTextCompare) > 0 _ Or InStr(1, c.Value, "短信", vbTextCompare) > 0 _ Or InStr(1, c.Value, "敲门", vbTextCompare) > 0 _ Or InStr(1, c.Value, "邀评", vbTextCompare) > 0 Then c.Characters(Start:=1, Length:=Len(c.Value)).Font.ColorIndex = 3 '3代表红色 End If Next c End Sub这个宏会找到EJ列中包含关键字 "电话""要好评" "短信" "敲门"" 邀评"的文本，将其标记为红色。
只需在Excel中打开你要处理的工作簿，并打开VBA编辑器，在模块中添加以上代码，然后按下F5运行，即可完成标红处理。
@ChatGPT 按照步骤讲解上述如何在excel中运行？
好的，以下步骤告诉您如何在Excel中运行此宏：
-
打开您的Excel工作簿，并进入VBA编辑器
您可以通过按下键盘上的Alt + F11键或在“开发者”选项卡中点击“Visual Basic”按钮来打开VBA编辑器。 -
在VBA编辑器中，选择想要在其中添加宏的工作表。
在工程窗格中，找到工作簿所在地，双击该工作簿以展开其项目列表。选中要运行宏的工作表，右键单击该工作表并选择“插入”> “模块”以添加新模块。 -
在新模块中输入宏代码。
将前面提供的宏代码复制并粘贴到空白模块中。 -
保存并关闭VBA编辑器。
按下Alt + Q可以退出VBA编辑器。 -
运行宏。
在Excel的工作表中，按下Alt + F8将打开“宏”对话框。选中要运行的宏并点击“运行”即可。
请注意，每次更改和保存Excel工作簿时，您需要在打开VBA编辑器之前启用“宏”。如果没有启用“宏”，则无法使用VBA代码运行宏。
-
-
此回复已被删除！
-
Mockingbird 说：
ChatGPT 说：
Mockingbird 说：
@ChatGPT 你现在是一个VBA 宏专家，请帮我用VBA 宏写一个代码，它需要做到将EJ列中包含关键字"电话""要好评" "短信" "敲门"" 邀评"的文本标红处理
当然可以，以下是符合您要求的VBA宏代码：
Sub highlightKeywords() Dim LastRow As Long Dim c As Range Dim ws As Worksheet Set ws = ThisWorkbook.ActiveSheet LastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row For Each c In ws.Range("E2:E" & LastRow) If InStr(1, c.Value, "电话", vbTextCompare) > 0 _ Or InStr(1, c.Value, "要好评", vbTextCompare) > 0 _ Or InStr(1, c.Value, "短信", vbTextCompare) > 0 _ Or InStr(1, c.Value, "敲门", vbTextCompare) > 0 _ Or InStr(1, c.Value, "邀评", vbTextCompare) > 0 Then c.Characters(Start:=1, Length:=Len(c.Value)).Font.ColorIndex = 3 '3代表红色 End If Next c End Sub这个宏会找到EJ列中包含关键字 "电话""要好评" "短信" "敲门"" 邀评"的文本，将其标记为红色。
只需在Excel中打开你要处理的工作簿，并打开VBA编辑器，在模块中添加以上代码，然后按下F5运行，即可完成标红处理。
@ChatGPT 按照步骤讲解上述如何在excel中运行？
以下是在Excel中运行VBA宏的步骤：
-
打开您想要运行VBA宏的Excel文档。
-
确认已启用开发工具选项。如果您未启用此选项，请执行以下操作：
- 点击 Excel 上方的 "文件" 选项卡。
- 点击 "选项"。
- 在 "自定义功能区" 中，选中 "主选项卡" 后面的复选框，然后选中 "开发工具" 中的复选框。
- 单击 "确定"。
-
打开 Visual Basic Editor (VBE)。
- 点击 "开发工具" 选项卡上的 "Visual Basic" 按钮。
- 或按 "Alt + F11"。
-
在 "模块" 中添加 VBA 宏代码。
- 在 "项目 - VBAProject" 窗口中，通过双击 "模块" 打开。
- 在 "标准" 模块上单击右键，并选择 "插入" -> "模块"。
- 复制并粘贴VBA宏代码。
-
运行 VBA 宏。
- 在 VBE 中，单击 VBA 宏中的任意位置。
- 按 "F5" 或单击工具栏上的 "运行" 按钮。
这样，VBA宏就会在Excel文档中运行。请确保您已正确设置 Excel 文档中的单元格和范围，以便宏可以正常工作。
-
-
你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话""要好评" "短信" "敲门""邀评"”"反复""骚扰""多次""索要"的文本标红处理@ChatGPT
-
@ChatGPT 你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话""要好评" "短信" "敲门""邀评"”"反复""骚扰""多次""索要"的文本标红处理
-
Mockingbird 说：
@ChatGPT 你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话""要好评" "短信" "敲门""邀评"”"反复""骚扰""多次""索要"的文本标红处理
以下是一个简单的 VBA 宏，它可以让 EJ 列中包含指定关键字的文本标红：
Sub HighlightKeywords() Dim Cell As Range Dim Keywords As Variant Dim Keyword As Variant '添加需要匹配的关键字 Keywords = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", "骚扰", "多次", "索要") '使用 For 循环逐个寻找关键字并高亮文本 For Each Cell In Range("EJ:EJ") For Each Keyword In Keywords If InStr(1, Cell.Value, Keyword) Then Cell.Font.ColorIndex = 3 End If Next Keyword Next Cell End Sub使用方式：
- 打开 Excel 文档，按下 Alt + F11 快捷键打开 VBA 编辑器。
- 在编辑器中插入一个模块，然后将以上代码复制到模块中。
- 定位到 Sheet1，选中 EJ 列中需要标红的文本。
- 在 VBA 编辑器中点击“运行”按钮即可。
请注意，这段代码基于一个简单的搜索匹配算法，在文本中只要包含指定的关键词，无论出现在什么位置，都会被标红。如果需要更精确的匹配算法，请告诉我。
-
ChatGPT 说：
Mockingbird 说：
@ChatGPT 你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话""要好评" "短信" "敲门""邀评"”"反复""骚扰""多次""索要"的文本标红处理
以下是一个简单的 VBA 宏，它可以让 EJ 列中包含指定关键字的文本标红：
Sub HighlightKeywords() Dim Cell As Range Dim Keywords As Variant Dim Keyword As Variant '添加需要匹配的关键字 Keywords = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", "骚扰", "多次", "索要") '使用 For 循环逐个寻找关键字并高亮文本 For Each Cell In Range("EJ:EJ") For Each Keyword In Keywords If InStr(1, Cell.Value, Keyword) Then Cell.Font.ColorIndex = 3 End If Next Keyword Next Cell End Sub使用方式：
- 打开 Excel 文档，按下 Alt + F11 快捷键打开 VBA 编辑器。
- 在编辑器中插入一个模块，然后将以上代码复制到模块中。
- 定位到 Sheet1，选中 EJ 列中需要标红的文本。
- 在 VBA 编辑器中点击“运行”按钮即可。
请注意，这段代码基于一个简单的搜索匹配算法，在文本中只要包含指定的关键词，无论出现在什么位置，都会被标红。如果需要更精确的匹配算法，请告诉我。
需要精确匹配算法并且仅标红加粗关键字，对应单元格填充黄色
-
Mockingbird 说：
@ChatGPT 需要精确匹配算法并且仅标红加粗关键字，对应单元格填充黄色
您好！提供一个精确匹配并在单元格中标红加粗关键字，并将对应单元格填充黄色的VBA代码：
Sub HighlightKeywords() Dim keyword As String Dim value As String Dim cell As Range For Each cell In Selection value = cell.Value For Each keyword In Split("Keyword1,Keyword2,Keyword3", ",") If InStr(1, value, keyword, vbTextCompare) > 0 Then value = Replace(value, keyword, "" & keyword & "", Compare:=vbTextCompare) cell.Value = value cell.Interior.Color = RGB(255, 255, 0) End If Next keyword Next cell End Sub在代码中，您需要将 "Keyword1,Keyword2,Keyword3" 替换为您要匹配的关键字，多个关键字间用逗号分隔。将代码复制到Excel宏中，选中要处理的单元格，运行代码即可。
请注意，这段代码仅适用于选中单元格的处理。如果您需要处理整个工作表，请将代码修改为适合整个工作表的形式。
-
此回复已被删除！
-
此回复已被删除！
-
@ChatGPT
你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本标红加粗处理，并将所在单元格填充黄色，在EJ列之后插入一列命名"判罚"。 -
Mockingbird 说：
@ChatGPT
你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本标红加粗处理，并将所在单元格填充黄色，在EJ列之后插入一列命名"判罚"。好的，以下是参考代码，请按照实际情况进行适当修改：
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList If InStr(1, c.Text, keyword) > 0 Then '找到关键字时进行标红加粗和填充黄色操作 c.Font.Bold = True c.Font.ColorIndex = 3 '设置字体颜色为红色 c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" Exit For '找到一个关键字后，就跳出循环 End If Next keyword Next c End Sub请打开Excel文件，按下Alt + F11，打开VBA编辑器，将以上代码复制到一个新模块中，保存后返回到Excel页面，按下Alt + F8，选择刚刚新建的宏，运行即可。
希望能对您有所帮助！
-
ChatGPT 说：
Mockingbird 说：
@ChatGPT
你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本标红加粗处理，并将所在单元格填充黄色，在EJ列之后插入一列命名"判罚"。好的，以下是参考代码，请按照实际情况进行适当修改：
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList If InStr(1, c.Text, keyword) > 0 Then '找到关键字时进行标红加粗和填充黄色操作 c.Font.Bold = True c.Font.ColorIndex = 3 '设置字体颜色为红色 c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" Exit For '找到一个关键字后，就跳出循环 End If Next keyword Next c End Sub请打开Excel文件，按下Alt + F11，打开VBA编辑器，将以上代码复制到一个新模块中，保存后返回到Excel页面，按下Alt + F8，选择刚刚新建的宏，运行即可。
希望能对您有所帮助！
@ChatGPT 上面的代码中存在错误，仅对关键字加粗标红，并非整个单元格
-
Mockingbird 说：
ChatGPT 说：
Mockingbird 说：
@ChatGPT
你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本标红加粗处理，并将所在单元格填充黄色，在EJ列之后插入一列命名"判罚"。好的，以下是参考代码，请按照实际情况进行适当修改：
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList If InStr(1, c.Text, keyword) > 0 Then '找到关键字时进行标红加粗和填充黄色操作 c.Font.Bold = True c.Font.ColorIndex = 3 '设置字体颜色为红色 c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" Exit For '找到一个关键字后，就跳出循环 End If Next keyword Next c End Sub请打开Excel文件，按下Alt + F11，打开VBA编辑器，将以上代码复制到一个新模块中，保存后返回到Excel页面，按下Alt + F8，选择刚刚新建的宏，运行即可。
希望能对您有所帮助！
@ChatGPT 上面的代码中存在错误，仅对关键字加粗标红，并非整个单元格
非常抱歉，没能注意到这个错误，下面是解决这个问题的代码
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList '找到关键字时进行标红加粗和填充黄色操作 If InStr(1, c.Value, keyword) > 0 Then With c.Characters(Start:=InStr(1, c.Value, keyword), Length:=Len(keyword)).Font '标红加粗 .Bold = True .ColorIndex = 3 End With c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" End If Next keyword Next c End Sub代码解释：
-
VBA会循环遍历文本中的每一个字符，因此我们需要使用
c.Characters来操作该字符； -
使用
InStr函数来查找关键字在文本中的位置，如果找到了，就用Bold=True和ColorIndex=3来标记该字符； -
Len(keyword)返回关键字的长度，从而确定使用Characters方法时需要提取的字符数量。
希望这次能对您有所帮助。如果您有其他问题，可以随时在该帖子下方留言。
-
-
ChatGPT 说：
Mockingbird 说：
ChatGPT 说：
Mockingbird 说：
@ChatGPT
你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本标红加粗处理，并将所在单元格填充黄色，在EJ列之后插入一列命名"判罚"。好的，以下是参考代码，请按照实际情况进行适当修改：
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList If InStr(1, c.Text, keyword) > 0 Then '找到关键字时进行标红加粗和填充黄色操作 c.Font.Bold = True c.Font.ColorIndex = 3 '设置字体颜色为红色 c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" Exit For '找到一个关键字后，就跳出循环 End If Next keyword Next c End Sub请打开Excel文件，按下Alt + F11，打开VBA编辑器，将以上代码复制到一个新模块中，保存后返回到Excel页面，按下Alt + F8，选择刚刚新建的宏，运行即可。
希望能对您有所帮助！
@ChatGPT 上面的代码中存在错误，仅对关键字加粗标红，并非整个单元格
非常抱歉，没能注意到这个错误，下面是解决这个问题的代码
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList '找到关键字时进行标红加粗和填充黄色操作 If InStr(1, c.Value, keyword) > 0 Then With c.Characters(Start:=InStr(1, c.Value, keyword), Length:=Len(keyword)).Font '标红加粗 .Bold = True .ColorIndex = 3 End With c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" End If Next keyword Next c End Sub代码解释：
-
VBA会循环遍历文本中的每一个字符，因此我们需要使用
c.Characters来操作该字符； -
使用
InStr函数来查找关键字在文本中的位置，如果找到了，就用Bold=True和ColorIndex=3来标记该字符； -
Len(keyword)返回关键字的长度，从而确定使用Characters方法时需要提取的字符数量。
希望这次能对您有所帮助。如果您有其他问题，可以随时在该帖子下方留言。
@ChatGPT 上面的代码中存在错误，在EJ列之后插入一列命名"判罚"仅需要执行一次，并非每次都执行。
-
-
Mockingbird 说：
ChatGPT 说：
Mockingbird 说：
ChatGPT 说：
Mockingbird 说：
@ChatGPT
你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本标红加粗处理，并将所在单元格填充黄色，在EJ列之后插入一列命名"判罚"。好的，以下是参考代码，请按照实际情况进行适当修改：
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList If InStr(1, c.Text, keyword) > 0 Then '找到关键字时进行标红加粗和填充黄色操作 c.Font.Bold = True c.Font.ColorIndex = 3 '设置字体颜色为红色 c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" Exit For '找到一个关键字后，就跳出循环 End If Next keyword Next c End Sub请打开Excel文件，按下Alt + F11，打开VBA编辑器，将以上代码复制到一个新模块中，保存后返回到Excel页面，按下Alt + F8，选择刚刚新建的宏，运行即可。
希望能对您有所帮助！
@ChatGPT 上面的代码中存在错误，仅对关键字加粗标红，并非整个单元格
非常抱歉，没能注意到这个错误，下面是解决这个问题的代码
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList '找到关键字时进行标红加粗和填充黄色操作 If InStr(1, c.Value, keyword) > 0 Then With c.Characters(Start:=InStr(1, c.Value, keyword), Length:=Len(keyword)).Font '标红加粗 .Bold = True .ColorIndex = 3 End With c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 '在EJ列后面插入一列 Range("EK1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" End If Next keyword Next c End Sub代码解释：
-
VBA会循环遍历文本中的每一个字符，因此我们需要使用
c.Characters来操作该字符； -
使用
InStr函数来查找关键字在文本中的位置，如果找到了，就用Bold=True和ColorIndex=3来标记该字符； -
Len(keyword)返回关键字的长度，从而确定使用Characters方法时需要提取的字符数量。
希望这次能对您有所帮助。如果您有其他问题，可以随时在该帖子下方留言。
@ChatGPT 上面的代码中存在错误，在EJ列之后插入一列命名"判罚"仅需要执行一次，并非每次都执行。
非常感谢您的指正，下面是修改后的代码，已将判罚列的插入移到了循环外部。
Sub Highlight_Cell() Dim rng As Range Dim keywordList As Variant Dim keyword As Variant keywordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", _ "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", _ "不要给差评", "追着") '在EJ列后面插入一列 Range("EJ1").Offset(0, 1).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("EK1").Value = "判罚" '设置要操作的单元格范围 Set rng = Range("EJ:EJ") '循环判断每个单元格文本是否包含关键字 For Each c In rng For Each keyword In keywordList '找到关键字时进行标红加粗和填充黄色操作 With c.Characters(Start:=InStr(1, c.Value, keyword), Length:=Len(keyword)).Font '标红加粗 .Bold = True .ColorIndex = 3 End With c.Interior.ColorIndex = 6 '设置单元格填充颜色为黄色 Exit For '找到一个关键字后，就跳出循环 Next keyword Next c End Sub代码解释：
- 插入一列代码被移动到循环外部，使其只执行一次。
我们也欢迎您将其他问题和需求留在该帖子下方，我们会及时进行回复和修改。
-
-
-
Mockingbird 说：
@ChatGPT 你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到在EJ列之后插入一列命名"判罚"，将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本中的关键字进行标红加粗处理，并将所在单元格填充黄色。
不好意思，作为一个智能机器人，我不支持VBA编程。不过，我可以帮您找到一些示例代码和资源，帮您完成您的需求。
以下是一个示例代码，可以完成您的需求（可适当修改）：
Sub MarkOffensiveWords() Dim ws As Worksheet Dim cell As Variant Dim i As Long Dim MarkRange As Range Dim WordList As Variant WordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", "不要给差评", "追着") Set ws = ActiveSheet ws.Columns("EJ").Insert Shift:=xlToRight Set MarkRange = ws.Range("EK:EK") MarkRange.Value = "" For i = LBound(WordList) To UBound(WordList) Set cell = MarkRange.Find(WordList(i), LookIn:=xlValues, LookAt:=xlPart) If Not cell Is Nothing Then Do With cell .Characters(Start:=InStr(1, cell.Value, WordList(i), vbTextCompare), Length:=Len(WordList(i))).Font.Bold = True .Characters(Start:=InStr(1, cell.Value, WordList(i), vbTextCompare), Length:=Len(WordList(i))).Font.ColorIndex = 3 .Interior.ColorIndex = 6 End With Set cell = MarkRange.FindNext(cell) Loop While Not cell Is Nothing And cell.Address <> FirstAddr End If Next i End Sub代码中，输入了您要查找的关键词组成的数组，代码会遍历这个列表，并在EK列中查找这个词，如果存在，则将这个单元格的内容高亮显示。
注意：在使用此宏之前，为了避免数据丢失，强烈建议先备份您的工作表。
提示：如果您没有经验，可以考虑先学习 VBA 基础教程。
-
ChatGPT 说：
Mockingbird 说：
@ChatGPT 你现在是一个[VBA 宏]专家，请帮我用[VBA 宏]写一个代码，它需要做到在EJ列之后插入一列命名"判罚"，将EJ列中包含关键字"电话,要好评,短信,敲门,邀评,反复,骚扰,多次,索要,邀评,催评价,催要评价,不要给差评,追着"的文本中的关键字进行标红加粗处理，并将所在单元格填充黄色。
不好意思，作为一个智能机器人，我不支持VBA编程。不过，我可以帮您找到一些示例代码和资源，帮您完成您的需求。
以下是一个示例代码，可以完成您的需求（可适当修改）：
Sub MarkOffensiveWords() Dim ws As Worksheet Dim cell As Variant Dim i As Long Dim MarkRange As Range Dim WordList As Variant WordList = Array("电话", "要好评", "短信", "敲门", "邀评", "反复", "骚扰", "多次", "索要", "邀评", "催评价", "催要评价", "不要给差评", "追着") Set ws = ActiveSheet ws.Columns("EJ").Insert Shift:=xlToRight Set MarkRange = ws.Range("EK:EK") MarkRange.Value = "" For i = LBound(WordList) To UBound(WordList) Set cell = MarkRange.Find(WordList(i), LookIn:=xlValues, LookAt:=xlPart) If Not cell Is Nothing Then Do With cell .Characters(Start:=InStr(1, cell.Value, WordList(i), vbTextCompare), Length:=Len(WordList(i))).Font.Bold = True .Characters(Start:=InStr(1, cell.Value, WordList(i), vbTextCompare), Length:=Len(WordList(i))).Font.ColorIndex = 3 .Interior.ColorIndex = 6 End With Set cell = MarkRange.FindNext(cell) Loop While Not cell Is Nothing And cell.Address <> FirstAddr End If Next i End Sub代码中，输入了您要查找的关键词组成的数组，代码会遍历这个列表，并在EK列中查找这个词，如果存在，则将这个单元格的内容高亮显示。
注意：在使用此宏之前，为了避免数据丢失，强烈建议先备份您的工作表。
提示：如果您没有经验，可以考虑先学习 VBA 基础教程。
@ChatGPT 你可以的，重新优化一下代码
