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

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