如何将字体和内部颜色从一个多单元格范围复制到另一个？

Question

我有一个包含多个单元格的范围，我想将该范围的字体颜色和内部颜色复制到相同大小的另一个范围。我使用此代码进行测试：

Sub testColorCopy()

Dim sht As Worksheet
Dim rng As Range
Dim rng2 As Range

Set sht = ThisWorkbook.Sheets("Sheet1")
sht.Range("a1").value = "abc"
sht.Range("c1").value = "def"
sht.Range("a1").Font.ColorIndex = 3
sht.Range("b1").Interior.ColorIndex = 4

Set rng = sht.Range("a1:b1")
Set rng2 = sht.Range("c1:d1")

rng2.Interior.color = rng.Interior.color
rng2.Font.color = rng.Font.color


End Sub

但这并不能复制正确的颜色;两个目标单元格最终变黑，这表明源单元格中的颜色值可能会加在一起吗？

迭代范围内的每个单元格，但该解决方案不能很好地扩展 - 我需要能够合理快速处理1,000,000多个单元格的东西。

编辑：我只想复制字体颜色和内部颜色 - 没有其他格式化属性。

Answer 1

这是使用偏移量解决问题的另一种方法。您的偏移量是要粘贴到的第一个单元格的rowid和colid。

  Sub testColorCopy()

    Dim sht As Worksheet
    Dim rng As Range
    Dim rng2 As Range

    Set sht = ThisWorkbook.Sheets("Feuil1")
    sht.Range("a1").Value = "abc"
    sht.Range("b1").Value = "def"
    sht.Range("a1").Font.ColorIndex = 3
    sht.Range("b1").Interior.ColorIndex = 4

    Set rng = sht.Range("a1:b1")

    Dim rowoffset As Long: rowoffset = 0
    Dim coloffset As Long: coloffset = 2

    For Each cell In rng
    cell.Offset(rowoffset, coloffset).Interior.ColorIndex = cell.Interior.ColorIndex
    cell.Offset(rowoffset, coloffset).Font.ColorIndex = cell.Font.ColorIndex
    Next cell


End Sub

示例输出：

编辑：抱歉，没看过你的最后一句话。这里是如何在不迭代细胞的情况下完成的：

Sub testColorCopy()

Dim sht As Worksheet
Dim rng As Range
Dim rng2 As Range

Set sht = ThisWorkbook.Sheets("Feuil1")
sht.Range("a1").Value = "abc"
sht.Range("b1").Value = "def"
sht.Range("a1").Font.ColorIndex = 3
sht.Range("b1").Interior.ColorIndex = 4

Set rng = sht.Range("a1:b1")
Set rng2 = sht.Range("c1:d1")

rng.Copy
rng2.Parent.Activate
rng2.PasteSpecial xlPasteFormats
Application.CutCopyMode = False

End Sub