时间戳

首页 > 解决方案 > Excel VBA：查找值并仅粘贴颜色（没有颜色的问题）

excel - Excel VBA：查找值并仅粘贴颜色（没有颜色的问题）

问题描述

好久不见。我正在处理一个小任务，不知何故我无法绕过我的头。我有一个巨大的 Excel 表（大约 4000 行），它正在被拆分并发送给人们 - 他们在特定行中从 K 列到 T 列标记黄色或红色单元格，并每周将其发回，直到范围 K 到 T在这 4000 行中，具有“X”值（表示已发送）被标记为黄色或红色（已收到或未收到）。excel 工作表在 J 列中具有唯一值（所以我使用 MATCH）。因此，通过使用此列 J，我将遍历数据（主表）中的每一行，并检查是否在输入表中找到它（用户返回的东西），如果找到，我去复制他们的颜色标记到原始数据表。这非常适合那些黄色和红色的颜色，子本身运行得很快——只是想知道是否没有错误（我上次做一些宏是在 3 年前）。问题 - 如果单元格是空的，它会以白色的形式粘贴回数据表，并且 Excel 的原始网格消失了（难以阅读）。谁能指出我正确的方向？谢谢！

Sub test4()
Application.ScreenUpdating = False
Set dat = Sheets("Data")
n = dat.Range("J" & Rows.Count).End(xlUp).Row

Dim test As Long
For i = 2 To n
    inputrow = 0
    On Error Resume Next
    inputrow = Application.WorksheetFunction.Match(Worksheets("Data").Range("J" & i).Value, Sheets("Input").Range("J:J"), 0)
    On Error GoTo 0
    If inputrow > 0 Then
o = dat.Range("A" & Rows.Count).End(xlUp).Row + 1
        dat.Range("K" & i).Interior.Color = Sheets("Input").Range("K" & inputrow).DisplayFormat.Interior.Color
        dat.Range("L" & i).Interior.Color = Sheets("Input").Range("L" & inputrow).DisplayFormat.Interior.Color
        dat.Range("M" & i).Interior.Color = Sheets("Input").Range("M" & inputrow).DisplayFormat.Interior.Color
        dat.Range("N" & i).Interior.Color = Sheets("Input").Range("N" & inputrow).DisplayFormat.Interior.Color
        dat.Range("O" & i).Interior.Color = Sheets("Input").Range("O" & inputrow).DisplayFormat.Interior.Color
        dat.Range("P" & i).Interior.Color = Sheets("Input").Range("P" & inputrow).DisplayFormat.Interior.Color
        dat.Range("Q" & i).Interior.Color = Sheets("Input").Range("Q" & inputrow).DisplayFormat.Interior.Color
        dat.Range("R" & i).Interior.Color = Sheets("Input").Range("R" & inputrow).DisplayFormat.Interior.Color
        dat.Range("S" & i).Interior.Color = Sheets("Input").Range("S" & inputrow).DisplayFormat.Interior.Color
        dat.Range("T" & i).Interior.Color = Sheets("Input").Range("T" & inputrow).DisplayFormat.Interior.Color
    End If
Next i

End Sub

标签： excelvbacolorsmatch

解决方案

DisplayFormat.Interior.ColorIndex = xlNone如果单元格没有被着色，则为 True。除非您使用条件格式，否则您不需要DisplayFormat

Sub test4()
    Dim test As Long, inputrow, dat As Worksheet, wsInput As Worksheet
    Dim n As Long, i As Long, c As Long, o
    
    Application.ScreenUpdating = False
    
    Set wsInput = Sheets("Input")
    Set dat = Sheets("Data")
    
    n = dat.Range("J" & Rows.Count).End(xlUp).Row
    
    For i = 2 To n
        
        inputrow = Application.Match(dat.Range("J" & i).Value, wsInput.Range("J:J"), 0)
        
        If Not IsError(inputrow) Then 'check for match
            o = dat.Range("A" & Rows.Count).End(xlUp).Row + 1
            'loop over columns
            For c = 11 To 20
                With wsInput.Rows(inputrow).Cells(c)
                    'copy color if cell is not default color
                    If .Interior.ColorIndex <> xlNone Then
                        dat.Cells(i, c).Interior.Color = .Interior.Color
                    End If
                End With
            Next c
        End If 'got match
    Next i
End Sub

推荐阅读