Question

我有多张包含数据的表。我已经用不同的颜色（大多数是绿色）突出显示了每个工作表中的一些行，我想将它们复制到一个工作表

我到目前为止所拥有的

SELECT CheckIn.TimeIn, CheckOut.TimeOut
FROM dbo.TestAtte AS CheckIn
OUTER APPLY
(
SELECT TOP 1 TimeOut
FROM dbo.TestAtte AS AllOut
WHERE AllOut.TimeOut > CheckIn.TimeIn
ORDER BY AllOut.TimeOut ASC
) AS CheckOut
WHERE TimeIn IS NOT NULL

我希望Sub Copy_If_colored() Dim sh As Worksheet, N As Long Dim i As Long, M As Long, J As Long Dim xCell As Range, xRg As Range N = Sheets.Count - 1 M = 2 For i = 1 To N J = Sheets(i).UsedRange.Rows.Count Set xRg = Sheets(i).Range("A1:A" & J) For Each xCell In xRg If xCell.Interior.Color <> RGB(255, 255, 255) Then Sheets(i).Range(xCell).Copy Sheets("Recommended").Range("A" & M).PasteSpecial (xlValues) Sheets("Recommended").Range("A" & M).PasteSpecial (xlFormats) M = M + 1 End If Next Next i End Sub能够捕获任何颜色，因为它是默认颜色代码中返回的值，对吗？还是..<> RGB(255, 255, 255)更正确？

Answer 1

您的代码中有一些错误，这是您的固定代码：

   Sub Copy_If_colored()
   Dim sh As Worksheet
   Dim i As Long, M As Long
   Dim rngRow As Range

   M = 2 'Start at second row, since first row contains headers

   For i = 1 To Sheets.Count - 1 'Make sure "Recommended" is the last sheet
       For Each rngRow In Sheets(i).UsedRange.Rows 'Going through rows instead of every cell should be considerably faster
           If Sheets(i).Range("A" & rngRow.Row).Interior.ColorIndex <> xlNone Then
               rngRow.Copy Sheets("Recommended").Range("A" & M)
               M = M + 1
           End If
       Next
   Next i
End Sub

要仅将数据复制为值，请使用以下方法：

rngRow.Copy
Sheets("Recommended").Range("A" & M).PasteSpecial xlValues

请注意，这不会复制格式，如果您还需要复制数字格式等，请添加以下行：

Sheets("Recommended").Range("A" & M).PasteSpecial xlFormats

Answer 2

如果要与RGB而不是：

进行比较

If CStr(xCell.Value) <> RGB(255, 255, 255) Then

尝试使用：

If xCell.Interior.Color <> RGB(255, 255, 255) Then

还需要设置范围xRg

从多张纸复制彩色单元并粘贴到一张纸中

2 个答案: