【问题标题】：Excel: transfer color filling from one document to anotherExcel：将颜色填充从一个文档转移到另一个文档
【发布时间】：2020-12-08 07:39:04
【问题描述】：

我有两个文档有一些相同的行（有些行是不同的）。在 Document1 中，我使用文件并为某些行（或单元格）着色。
如何切换到Documnent2 并以相同的方式为我在Document1 中着色的行（单元格）着色？有没有可用的解析器？

例如：
Doc1：

1   a 1 2 3 4  # is full colored
2   b 1 3 6 7
3   c 1 1 1 2  # is full colored

Doc2:

1   c 1 1 1 2
2   a 1 2 3 4
3   d 5 6 8 1
4   b 1 3 6 7

我需要为索引为 1 和 2 的行着色，因为它们与 Doc1 中的相同，并且是全彩色的。

如果我使用Format Painter，我会得到第一行和第三行的颜色，但这对我来说是错误的。

我看到了类似公式的解决方案，它通过行字母检查，是否着色，并为其他文档中的行字母着色。但我不知道如何编码:(

附：我也无法获取单元格颜色 - GET.CELL(63,INDIRECT("rc",FALSE)) 对我不起作用，没有找到 GET.CELL() 函数。

附言两个文档都太大（超过 1.000.000 行），所以我认为最好的解决方案是公式（宏通常太慢）。

【问题讨论】：

Format Painter 呢？
您遇到了麻烦，因为GET.CELL 是一个已弃用的旧宏，虽然这可以帮助您获取源工作表颜色，但没有可用的方法将此颜色设置到您的新工作表上，这应该是一个逻辑问题 - 我的目标表可以保存其相应的数字数据，或者具有设置颜色的逻辑的公式，而不是两者。您可以改为查看条件格式并使用它将相同的着色逻辑应用于两个工作表。
据我所知，你不能用公式复制颜色/格式，所以只有用公式你才能做到。

标签： excel colors formula

【解决方案1】：

代码的速度取决于有多少单元格被着色

您必须对其进行调整以适应您的需求

Option Explicit
' Credits: https://stackoverflow.com/a/30067221/1521579
' Credits: https://www.mrexcel.com/board/threads/vba-to-compare-rows-in-two-different-sheets-and-if-they-match-highlight-in-red.1067232/
Sub CheckRows()

    Dim StartTime As Double
    Dim SecondsElapsed As Double
    
    StartTime = Timer
    
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    
    Dim targetFile As Workbook
    Set targetFile = ThisWorkbook 'Workbooks("File2")
    
    Dim targetSheet
    Set targetSheet = targetFile.Worksheets("Sheet2")
    
    Dim sourceLastRow As Long
    sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    Dim sourceRange As Range
    Set sourceRange = sourceSheet.Range("A1:E" & sourceLastRow)
    
    Dim targetLastRow As Long
    targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    Dim targetRange As Range
    Set targetRange = targetSheet.Range("A1:E" & targetLastRow)
    
    Dim tempDict As Object
    Set tempDict = CreateObject("scripting.dictionary")
    
    Dim cellsString As String
    
    ' Add first range to dict
    Dim sourceCell As Range
    Dim sourceCounter As Long
    For Each sourceCell In sourceRange.Columns(1).Cells
        sourceCounter = sourceCounter + 1
        ' Check if cell has color
        If sourceCell.Interior.Color <> 16777215 Then
            cellsString = Join(Application.Index(sourceCell.Resize(, sourceRange.Columns.Count).Value, 1, 0), "|")
            tempDict.item(cellsString) = sourceCell.Interior.Color
        End If
    Next sourceCell
    
    ' Check in target range
    Dim targetCell As Range
    Dim sourceColor As String
    For Each targetCell In targetRange.Columns(1).Cells
        cellsString = Join(Application.Index(targetCell.Resize(, targetRange.Columns.Count).Value, 1, 0), "|")
        If tempDict.exists(cellsString) Then
            sourceColor = tempDict.item(cellsString)
            targetCell.Resize(, targetRange.Columns.Count).Interior.Color = sourceColor
        End If
    Next targetCell
    
    SecondsElapsed = Round(Timer - StartTime, 2)
    Debug.Print SecondsElapsed, "Source rows:" & sourceLastRow, "Target rows: " & targetLastRow
End Sub

' Credits: https://stackoverflow.com/a/9029155/1521579
Function GetKey(Dic As Object, strItem As String) As String
    Dim key As Variant
    For Each key In Dic.Keys
        If Dic.item(key) = strItem Then
            GetKey = CStr(key)
            Exit Function
        End If
    Next
End Function

【讨论】：

【解决方案2】：

如果您对在两个文档中添加少量帮助列感到满意，可以使用以下解决方案。

请注意，以下解决方案演示了 2 张纸中的数据在同一个文档中。您可以轻松地应用相同的逻辑不同的文件。

假设：

两个文档中的列数保持不变
您正在寻找完全匹配

解决方案：

您可以从following link 下载带有以下解决方案的示例 excel 文档。

在两个文档中创建一个辅助列 (G)，它是使用 =TEXTJOIN(", ",FALSE,B2:E2) 连接所有现有列，如下所示：

    A B C D E F -----G-------
1   a 1 2 3 4   a, 1, 2, 3, 4
2   b 1 3 6 7   b, 1, 3, 6, 7
3   c 1 1 1 2   c, 1, 1, 1, 2

在 document2 中创建另一个列 (H)，它将使用 =IFERROR(MATCH(G2,'document 1'!$G$1:$G$5,0),0) 公式从 document1 中识别相应的行号。像下面
Note: 0 if no match is found

在任何单元格中添加一个公式，该公式将计算 document2 中应检查的总行数

    A B C D E F -------G-----    H
1   c 1 1 1 2   c, 1, 1, 1, 2    3
2   a 1 2 3 4   a, 1, 2, 3, 4    1
3   d 5 6 8 1   d, 5, 6, 8, 1    0
4   b 1 3 6 7   b, 1, 3, 6, 7    2
5
6               =COUNTA(G1:G4)

添加这些列后，您可以使用这些列循环遍历 document2 中的行并查看 document1 中是否存在匹配项，如果存在匹配项，则使用以下代码复制格式：

Public Sub Copy_Formatting()

'Stack Overflow question: https://stackoverflow.com/questions/65194893/excel-transfer-color-filling-from-one-document-to-another

Dim Curr_Range As Range, Match_Value As Integer, Rows_to_loop As Integer

Rows_to_loop = Sheet2.Range("G6").Value

For i = 1 To Rows_to_loop
    Set Curr_Range = Sheet2.Range("B1:E1").Offset(i, 0)
    Match_Value = Sheet2.Range("H1").Offset(i).Value
    If Match_Value > 0 Then
        Sheet1.Range("B1:E1").Offset(Match_Value - 1).Copy

        With Curr_Range.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With

        Curr_Range.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

        Application.CutCopyMode = False
    End If

Next i

End Sub

查看以下显示结果的 GIF：

【讨论】：

如果您想直接应用此代码，您可以将document1中的数据复制到document2中的新工作表并使用该代码。如果没有，有几种方法，例如引用不同的工作表、使用 VBA 复制数据和使用 Power Query 复制数据
如果您使用 VBA，为什么需要“帮助列”？
我们绝对可以用 VBA 做任何事情，但是 1. 这让 OP 可以清楚地了解代码背后的逻辑。这将帮助他们针对其他用例进行修改。 2. 这可能会让不熟悉 VBA 的人感到困惑。

【解决方案3】：

两个选项：

使用格式刷（标记要复制格式的单元格，单击格式刷图标，切换到文档 2，选择要粘贴格式的单元格）
使用 Ctrl-C 使用“粘贴格式” -> 转到文档 2 -> 选择性粘贴 -> 格式。

【讨论】：

也许我做错了什么，但我需要按值绘制行。两个文档是不同的，如果document2 包含与document1 相同的行（everythere），我需要像在document1 中一样绘制它。
我不确定我理解你的意思，你能分享一个例子吗？
好的，现在问题很清楚了。很遗憾，我没有给你答案。

【解决方案4】：

如果我正确理解您的问题：您只想将格式从 excel 文件 2 复制到 excel 文件 1，同时保留信息。

复制文件 2 中的所有内容。
将其粘贴到文件 1 中，然后按 ctrl。选择左下角的选项以仅保留格式。

如果您使用条件格式，您也可以只备份文件 2 并将文件 1 粘贴到文件 2 中，同时只保留文本（ctrl 粘贴选项之一）。

【讨论】：

您已经手动或通过文件中的规则对其进行了格式化。如果第一种方法不起作用（将文件 2 粘贴到 1 中），那么您已经有了特定于文件的规则，您只需将文件 1 的文本粘贴到 2 中即可解决此问题。