Вставка форматов без использования «.Copy» + «.Paste»

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

Из комментариев выше вы просто хотите скопировать цвет заливки, посмотрите на этот пример:

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

Как бы я ни ненавидел петли, это может быть тот случай, когда они вам нужны.

Answer 2

Мне нравится комментарий Тима, но также посмотрите, что вы пишете, у вас есть дополнительный 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