Question

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

问题：代码当前引用活动行，并且由于某种原因复制F2（用红色写）。我知道代码目前会尝试在单元格上复制/粘贴几次，我稍后会解决这个问题。

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, ActiveCell.Column).Copy
            Range("F" & (ActiveCell.row)).Select
            ActiveSheet.Paste
            End If
        Next cell
    Next row
End Sub

Answer 1

不确定我是否遵循您的逻辑。您的问题是您引用了活动单元格，但除了通过粘贴之外，您没有定义它或更改它。我想你的意思是参考cell（？）

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 2

您永远不会更改活动单元格，因此始终在活动单元格的第2行上调用复制命令，该行位于F列中。我更改了下面的代码以解决问题。

Sub CopyRed()
   Dim rng As Range
   Dim row As Range
   Dim cell As Range
   Dim ws As Worksheet

   Set ws = ThisWorkbook.ActiveSheet ' this should be improved to point at the correct worksheet by name

   Set rng = ws.Range("G3:BF900")

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

将红色文本标题复制到另一个范围

2 个答案: