Excel 基于字体颜色复制和粘贴单元格，基于相对位置粘贴值

基本上，我有一组单元格，它们总是使用绿色字体（位于当前的场景范围内）。我想将这些值复制并粘贴到一个新的范围（论文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

---

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

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

如果两个范围都是矩形/正方形（即每行具有相同的列数，每列具有相同的行数），则可以将每个的

循环替换为两个
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

非常感谢。源代码不是正方形，因此第二个代码工作正常。它的更新速度相当慢，我假设这是因为它正在逐个搜索每个单元格？@bigalbunyan，是的，我认为它很慢，因为逐个读取/写入单元格是一个缓慢的过程。通过在循环前后切换
Application.screenUpdate
，
Application.Calculation
，您可以在某种程度上加快速度。如果您提供有关区域的形状/位置的更多详细信息（以及导致某些单元格使用绿色字体的原因），可能更容易说明如何加快速度。对不起，我实际上误解了您的解决方案。范围的位置都是矩形的，因此两种解决方案中的任何一种都有效。单元格为绿色的原因是工作簿采用了颜色编码，以便于查看。例如，绿色值表示来自其他工作表的引用。黑色值是计算，蓝色值是输入。