vba 复制和粘贴值 - 带颜色

Copy and Paste Value - With Coloring

提问by GoldBishop

I am in the process of developing an Export macro on various worksheets in a workbook. That being said, i need to have the worksheets with the Export macro to export the values of a specified range (named range) and the color formats they hold from a conditional format.

我正在工作簿中的各种工作表上开发导出宏。话虽如此，我需要使用带有导出宏的工作表来导出指定范围（命名范围）的值以及它们从条件格式中保存的颜色格式。

One thing I do not need is to copy the conditional formats that created the coloring. I only want the resulting color of the various cells in the range.

我不需要的一件事是复制创建着色的条件格式。我只想要范围内各种单元格的结果颜色。

I have done this, code below, but when i open the rollup file, all the cells in question have the conditional formats pattern associated with them, which results in a coloring problem.

我已经这样做了，代码如下，但是当我打开汇总文件时，所有有问题的单元格都具有与其关联的条件格式模式，这会导致着色问题。

ws.range("rngAreaMetricDetail").Copy   'Area Mgr Store Metrics
newws.range("V3").PasteSpecial xlPasteValues    'Paste Values
newws.range("V3").PasteSpecial xlPasteFormats  'Paste Coloring
newws.Names.Add "rngAreaMetricDetail", Selection   'Create Named-Range from Selection

Thanx in advance.

提前谢谢。

回答by mischab1

Excel doesn't have an easy way to convert a conditional format into the results of the conditional format. You have to do everything manually:

Excel 没有一种简单的方法可以将条件格式转换为条件格式的结果。您必须手动完成所有操作：

• Check to see if the FormatCondition is being used on each cell.
• Manually assign the formats from the FormatCondition. (Borders, Font, Interior, & NumberFormat)
• If you have more than one FormatCondition, the latter formats override the earlier ones unless StopIfTrueis set.

• 检查是否在每个单元格上使用了 FormatCondition。
• 从 FormatCondition 手动分配格式。( Borders, Font, Interior, & NumberFormat)
• 如果您有多个 FormatCondition，除非StopIfTrue设置，否则后面的格式会覆盖前面的格式。

If you have Microsoft Word installed you can copy your range to Word and back to Excel letting Word take care of converting the formats.

如果您安装了 Microsoft Word，您可以将您的范围复制到 Word，然后再复制回 Excel，让 Word 负责转换格式。

Sub CopyConditionalFormattingThruWord(sAddress As String)
   Dim appWord As Word.Application, doc As Word.Document
   Dim wbkTo As Workbook

   ' copy from original table
   ThisWorkbook.Activate
   ThisWorkbook.Names!rngAreaMetricDetail.RefersToRange.Copy

   ' paste into word application and recopy
   Set appWord = New Word.Application
   With appWord
      .Documents.Add DocumentType:=wdNewBlankDocument
'      .Visible = True
      .Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      .Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
      DoEvents
      .Selection.Copy
   End With

   ' copy to new workbook
   Set wbkTo = Excel.Application.Workbooks.Add
   wbkTo.Worksheets(1).Range(sAddress).Select
   wbkTo.ActiveSheet.Paste
   DoEvents

   ' close Word
   appWord.Quit SaveChanges:=False

   MsgBox "Done."

End Sub

Note:This doesn't copy the formatting 100% correctly but for most things, it is probably good enough. In the below example, I have 3 conditional formats applied to rows 1-9 in the table on the left. The table on the right is the result of running CopyConditionalFormattingThruWord sAddress:="B3".

注意：这不会 100% 正确复制格式，但对于大多数情况，它可能已经足够了。在下面的示例中，我将 3 种条件格式应用于左侧表中的第 1-9 行。右边的表格是运行的结果 CopyConditionalFormattingThruWord sAddress:="B3"。

Excel 2010:If you were using Excel 2010, and didn't want to use Word, you can skip the FormatCondition testing by using the range's new DisplayFormatmember. From the help file:

Excel 2010：如果您使用的是 Excel 2010，并且不想使用 Word，则可以使用区域的新DisplayFormat成员跳过 FormatCondition 测试。从帮助文件：

Actions such as changing the conditional formatting or table style of a range can cause what is displayed in the current user interface to be inconsistent with the values in the corresponding properties of the Range object. Use the properties of the DisplayFormat object to return the values as they are displayed in the current user interface.

更改范围的条件格式或表格样式等操作可能会导致当前用户界面中显示的内容与 Range 对象的相应属性中的值不一致。使用 DisplayFormat 对象的属性返回在当前用户界面中显示的值。

You still have to manually assign the values from its Borders, Font, Interior, & NumberFormatetc.

您仍然需要手动分配来自其Borders、Font、Interior、 &NumberFormat等的值。

回答by Diogo

Try this code... Old one i use sometimes. I had to do Few things to make it good for you.

试试这个代码......我有时使用的旧代码。我必须做一些事情才能让它对你有好处。

Sub move()
Dim lrow As Long
Dim lrow2 As Long
Dim rng As Range

Sheets(3).Cells.Clear


With Sheets(1)
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9))
    rng.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

With Sheets(3)
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9))
    rng.Interior.Color = vbYellow
End With

With Sheets(2)
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9))
    rng.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

With Sheets(3)
    lrow2 = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(lrow2 - (lrow - 2), 1), .Cells(lrow2, 9))
    rng.Interior.Color = vbRed
End With

End Sub

回答by Siddharth Rout

Is this what you are trying?

这是你正在尝试的吗？

I am assuming that there is only one condition that you are checking. I have not done any error handling. Hope you will take care of that as well.

我假设您只检查一个条件。我没有做任何错误处理。希望你也能照顾好它。

Option Explicit

Sub Sample()
    Dim ws As Worksheet, newws As Worksheet

    Set ws = Sheets("Sheet1")
    Set newws = Sheets("Sheet2")

    '~~> Area Mgr Store Metrics
    ws.Range("rngAreaMetricDetail").Copy

    newws.Activate

    '~~> Paste Values
    Range("V3").PasteSpecial xlPasteValues

    Selection.Interior.ColorIndex = GetColor(Range("rngAreaMetricDetail"))
End Sub

Public Function GetColor(rng As Range)
    Dim oFC As FormatCondition

    Set rng = rng(1, 1)
    If rng.FormatConditions.Count > 0 Then
        For Each oFC In rng.FormatConditions
            GetColor = oFC.Interior.ColorIndex
            Exit For
        Next oFC
    End If
End Function