我之前曾尝试就此寻求帮助,但没有收到任何有用的答复。
我需要一个宏/VBA,将 A 列中的任何红色单词作为列表移动到 C 列。
但是,如果同一个单词在 A 列中突出显示多次,我只希望该单词进入 C 列一次(不重复),除非它是一个字符串。
我的数据如下
我曾尝试为此创建一个 vba(如下),但它没有按照我希望的方式工作......
Sub copy_red()
Dim LastRow As Long, x As Long, y As Long, txt1 As String, txt As String
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LastRow
txt1 = ""
txt = Cells(x, 1)
If txt <> "" Then
For y = Len(txt) To 1 Step -1
If Cells(x, 1).Characters(Start:=y, Length:=1).Font.Color = 255 Then
txt1 = Cells(x, 1).Characters(Start:=y, Length:=1).Text & txt1
End If
Next y
Cells(x, 3) = txt1
End If
Next x
End Sub
我得到的结果如下:
我想要实现的目标如下:
任何帮助都将不胜感激,因为我不知道从哪里开始......
谢谢
答案1
您可以添加代码(ActiveSheet.Range().RemoveDuplicates
)来告诉工作表从给定的范围内删除重复项。C:C
在活动工作表中添加范围将覆盖整个列。如果您需要特定范围,可以将其更改为所需的特定单元格范围。
您可以将此行添加到您共享的代码的末尾。
ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
答案2
(CharlieRB 的答案包含在这里,因为他比我早 1.3 年发布了答案)
您仍然缺少的部分是将同一单元格中的多个红色短语拆分为列表中的多个条目。这是因为您直到浏览完单元格中的所有文本后才将短语放入列表中。您需要在循环中内置一个转义符,以便在FOR
红色文本后点击黑色文本时存储结果,并在末尾放置一个转义符(以防最后一个字符是红色)
Sub copy_red()
Dim LastRow As Long, x As Long, y As Long, txt1 As String, txt As String
Dim copyRow As Long
copyRow = 1
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LastRow
txt1 = ""
txt = Cells(x, 1)
If txt <> "" Then
For y = 1 To Len(txt)
If Cells(x, 1).Characters(Start:=y, Length:=1).Font.Color = 255 Then
txt1 = txt1 & Cells(x, 1).Characters(Start:=y, Length:=1).Text
Else
If txt1 <> "" Then
Cells(copyRow, 3) = txt1
copyRow = copyRow + 1
txt1 = ""
End If
End If
Next y
If txt1 <> "" Then
Cells(copyRow, 3) = txt1
copyRow = copyRow + 1
txt1 = ""
End If
End If
Next x
ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
ActiveSheet.Range("C:C").Font.Color = RGB(255, 0, 0)
End Sub