Question

例如：

rngTo.Value = rngFrom.Value2 'Works
rngTo.NumberFormat = rngFrom.NumberFormat 'Works
rngTo.Cells.Interior.ColorIndex = rngFrom.Cells.Interior.ColorIndex 'Doesn't work
rngToPublish.Copy: rNG.PasteSpecial xlPasteFormats ' Does work

有没有办法在不使用xlPasteSpecial的情况下获得所需的效果？

Answer 1

我喜欢蒂姆的评论，但是，看看你写的是什么，你有一个额外的Cells在那里尝试没有Cells，看看它是否有效。

rngTo.Interior.ColorIndex = rngFrom.Interior.ColorIndex

<强>更新上述代码仅在colorindex在整个范围内具有相同值时才有效，否则无效。

更新2：

这将为你做到。以前发生的事情是ColorIndex不包含数组，只作为单个值，所以如果它有多个值，它将返回Null值。 Color也不包含多个值，因此如果它包含多个值，则返回白色。

Private Sub ColorRange()

    'Dim dicColors As Dictionary
    Dim dicColors As Object
    Dim dColor As Double
    Dim rCopy As Range, rPaste As Range, rNext As Range
    Dim wksCopy As Worksheet, wksPaste As Worksheet
    Dim vColor As Variant

    Set wksCopy = ActiveWorkbook.Worksheets("Sheet1")
    Set wksPaste = ActiveWorkbook.Worksheets("Sheet2")
    Set rCopy = wksCopy.UsedRange

    'Set dicColors = New Dictionary
    Set dicColors = CreateObject("Scripting.Dictionary")
    'Loop through entire range and get colors, place in dictionary.
    For Each rNext In rCopy
        dColor = rNext.Interior.Color
        If dicColors.Exists(dColor) Then
            Set dicColors(dColor) = Union(dicColors(dColor), wksPaste.Range(rNext.Address))
        Else
            Set rPaste = wksPaste.Range(rNext.Address)
            dicColors.Add dColor, rPaste
        End If
    Next rNext

    'Color the ranges
    For Each vColor In dicColors.Keys
        'If color isn't white then color it, otherwise leave black, if the 
        'worksheet you are copying to has colors already then you should do an
        'else statement to get rid of the coloring like this
        'dicColors(vColor).Interior.ColorIndex = xlNone
        If vColor <> 16777215 Then dicColors(vColor).Interior.Color = vColor
    Next vColor

End Sub

Answer 2

从上面的评论中你只想复制填充色，看看这个例子：

Sub CopyFillColour()

    Dim rCopy As Range, rPaste As Range
    Dim lRow As Long, lCol As Long

    Set rCopy = Range("A1:B4")
    Set rPaste = Range("C1:D4") '// Can be smaller than the copy range ie C1:C4

    For lRow = 1 To rPaste.Rows.Count
        For lCol = 1 To rPaste.Columns.Count
            rPaste(lRow, lCol).Interior.Color = rCopy(lRow, lCol).Interior.Color
            rPaste(lRow, lCol).Interior.Pattern = rCopy(lRow, lCol).Interior.Pattern
            rPaste(lRow, lCol).Interior.PatternColorIndex = rCopy(lRow, lCol).Interior.PatternColorIndex
        Next lCol
    Next lRow

End Sub

尽管我讨厌循环，但这可能是你需要它们的情况。

粘贴格式而不使用“.Copy”+“。Paste”

2 个答案: