根据字体颜色复制和粘贴单元格，根据相对定位粘贴值

Question

基本上，我有一组总是有绿色字体的单元格（位于 Current_Scenerio 范围内）。我想将这些值复制并粘贴到一个新范围（Thesis_A）中。

使用当前代码，它可以根据单元格何时被格式化为绿色来选择复制值。但是我无法将这些粘贴到具有相对定位的新范围中。

我需要保持范围是动态的，所以我不能使用绝对定位的偏移量，这一切都必须是相对的，因为范围会改变。

我想知道是否有办法返回一个单元格相对于另一个单元格的位置。例如，我命名了一个单元格 Current_Scenerio_Start，如果我可以得到这个单元格相对于 Current_Scenerio_Start 的位置（比如向下 5 行，跨 3 列），然后我可以将单元格字体为绿色时的值粘贴到我的相对于另一个起始位置的新范围。

不幸的是，我不知道该怎么做/如果可能的话。

Option Explicit

Sub PasteThesisA()

Dim CurrentScenrioRange As Range
Dim ThesisARange As Range
Dim Cell As Range

Set CurrentScenrioRange = Scenerios.Range("Current_Scenerio:Current_Scenerio_End")
Set ThesisARange = Scenerios.Range("Thesis_A:Thesis_A_End")


For Each Cell In CurrentScenrioRange
    Cell.Select
    If Cell.Font.Color = RGB(0, 176, 80) Then
        With Scenerios
            .Range(ThesisARange).Value = .Range(CurrentScenrioRange).Value
        End With
    End If
Next
End Sub

现在我只是收到错误，因为我知道我不是我想要正确粘贴到的范围

Answer 1

抱歉，我目前无法测试这些建议中的任何一个。它们似乎会起作用（在我的脑海中），但也许我错过了一些东西。

如果两个范围都是矩形/正方形（即每行具有相同的列数并且每列具有相同的行数），则可以将 For Each 循环交换为两个 For 循环（一个用于行，一个用于列）。比如：

Option Explicit

Sub PasteThesisA()

    Dim CurrentScenrioRange As Range
    Dim ThesisARange As Range

    Dim greenFontColour As Long
    greenFontColour = RGB(0, 176, 80)

    Set CurrentScenrioRange = Scenerios.Range("Current_Scenerio:Current_Scenerio_End")
    Set ThesisARange = Scenerios.Range("Thesis_A:Thesis_A_End")

    Dim rowIndex As Long
    For rowIndex = 1 To CurrentScenrioRange.Rows.Count
        Dim columnIndex As Long
        For columnIndex = 1 To CurrentScenrioRange.Columns.Count
            If CurrentScenrioRange(rowIndex, columnIndex).Font.Color = greenFontColour Then
                ThesisARange(rowIndex, columnIndex).Value = CurrentScenrioRange(rowIndex, columnIndex).Value
            End If
        Next columnIndex
    Next rowIndex
End Sub

否则（如果它们不是矩形/正方形），也许您可​​以尝试计算相对行和列索引：

Option Explicit

Sub PasteThesisA()

    Dim CurrentScenrioRange As Range
    Dim ThesisARange As Range

    Set CurrentScenrioRange = Scenerios.Range("Current_Scenerio:Current_Scenerio_End")
    Set ThesisARange = Scenerios.Range("Thesis_A:Thesis_A_End")

    Dim greenFontColour As Long
    greenFontColour = RGB(0, 176, 80)

    Dim Cell As Range
    For Each Cell In CurrentScenrioRange

        Dim relativeRowIndex As Long
        relativeRowIndex = Cell.Row - CurrentScenrioRange.Rows(1).Row + 1 ' Might be better to second figure in a variable, instead of re-reading.

        Dim relativeColumnIndex As Long
        relativeColumnIndex = Cell.Column - CurrentScenrioRange.Columns(1).Column + 1 ' Might be better to second figure in a variable, instead of re-reading.

        If Cell.Font.Color = greenFontColour Then
            ThesisARange(relativeRowIndex, relativeColumnIndex).Value = Cell.Value
        End If
    Next
End Sub