不使用".Copy“+ ".Paste”粘贴格式
不使用".Copy“+ ".Paste”粘贴格式
提问于 2011-10-27 06:31:44
例如：
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有没有办法在不使用PasteSpecial的情况下获得想要的效果？
回答 2
Stack Overflow用户
回答已采纳
发布于 2011-10-28 05:34:55
在上面的注释中，你只想复制填充颜色，看看这个例子：
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尽管我很讨厌循环，但这可能是你需要它们的地方。
Stack Overflow用户
发布于 2011-10-27 07:14:26
我喜欢蒂姆的评论，但同时，看看你正在写的东西，你有一个额外的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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/7909736
复制相关文章
相似问题
腾讯云开发者
