Question

目标：让多个单元格中红色的任何文本的列标题在与文本相同的行的F列中表示。

问题：如果同一行中的多个单元格包含红色文本，则当前代码会复制标题单元格并将它们相互粘贴。宁愿复制标题文本，并将其添加到该单元格中的任何其他文本。

我之前的问题得到了解答（谢谢SJR！），但这是一个有缺陷的概念。我认为我真的需要一种方法来复制文本并用逗号分隔每个实例，而不是复制有问题的单元格。一般的想法是模块正在寻找的红色文本是对工作表所做的更改，而我尝试填充的单元格是所做更改类型的摘要，类型是标题每一栏。

Sub CopyRed()

Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = Range("G3:BF900")

For Each row In rng.Rows
    For Each cell In row.Cells
        If cell.Font.ColorIndex = 3 Then
            Cells(2, cell.Column).Copy Range("F" & cell.row)
        End If
    Next cell
Next row

End Sub

Answer 1

你走了：

Sub CopyRed()

Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = Range("G3:BF900")
For Each row In rng.Rows
    For Each cell In row.Cells
        For i = 1 To Len(cell.Value)
            If cell.Characters(i, 1).Font.Color = vbRed and cell.value <> "" Then
                If Cells(cell.row, 6) = "" Then
                    Cells(cell.row, 6).Value = Cells(2, cell.Column).Value
                    Exit For
                Else
                    Cells(cell.row, 6).Value = Cells(cell.row, 6).Value & ", " & Cells(2, cell.Column).Value
                    Exit For
                End If
            End If
        Next i
    Next cell
Next row
End Sub

将多个标头表示为单个单元格

1 个答案: