Excel将工作表1和2中突出显示/黄色的所有值复制到工作表3

Question

我有一个excel工作簿，有3张表，前两张包含大量数据，第三张是空白的。

我想创建一个宏，复制所有突出显示/黄色单元格从工作表1 &2并粘贴到表格3中

我在宏中有一些代码，目前只是将表1复制到表3但它复制了所有内容，即使我使用了If .Interior.ColorIndex

Sub Yellow()
Dim LR As Long, i As Long, j As Long
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Worksheets("Sheet1").Range("A1:CF200" & i)
       If .Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44 Then
            .Copy Destination:=Worksheets("Sheet3").Range("J" & j)
            j = j + 1
        End If
    End With
Next i
End Sub

Answer 1

UPDATE:下面的代码修改为跳过黄色突出显示的空白单元格…

我可能会把它分成两个部分，一个脚本，通过表格循环和一个函数，检查单元格(Range)是否为黄色。下面的代码有很多注释，它们遍历了这些步骤:

Option Explicit
Sub PutYellowsOnSheet3()
Dim Sh As Worksheet, Output As Worksheet
Dim LastRow As Long, LastCol As Long
Dim Target As Range, Cell As Range, Dest As Range
Dim DestCounter As Long
'initialize destination counter and set references
DestCounter = 1
Set Output = ThisWorkbook.Worksheets("Sheet3")
'loop through sheets that are not named "Sheet3"
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Sheet3" Then
        With Sh
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            Set Target = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
        End With
        For Each Cell In Target '<~ loop through each cell in the target space
            If AmIYellow(Cell) And Cell.Value <> "" Then '<~ blank check too
                Set Dest = Output.Cells(DestCounter, 1)
                Cell.Copy Dest
                DestCounter = DestCounter + 1 '<~ keep incrementing on sheet 3
            End If
        Next Cell
    End If
Next Sh
End Sub
'call this function when you'd like to check if a range is yellow
Public Function AmIYellow(Cell As Range) As Boolean
    If Cell Is Nothing Then
        AmIYellow = False
    End If
    Select Case Cell.Interior.ColorIndex '<~ this is the yellow check
        Case 27, 12, 36, 40, 44
            AmIYellow = True
        Case Else
            AmIYellow = False
    End Select
End Function

Answer 2

您的病情
.Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44

总是求值为True(除了0之外的任何数字都是True)，所以实际上你的条件是:
'condition' Or True Or True ...
应该是:

  `.Interior.ColorIndex Like 27 _ 
  Or .Interior.ColorIndex Like 12 _
  Or .Interior.ColorIndex Like 36 _
  Or .Interior.ColorIndex Like 40 _
  Or .Interior.ColorIndex Like 44`

或者重写为:

Select Case .Interior.ColorIndex
    case 27,12,36,40,44
        'action
    Case Else
        'do nothing
End Select

Answer 3

您的脚本中有几个错误需要发现。我认为你想循环给定范围内的所有单元格，只复制具有指定颜色的单元格。可以这样做:

Sub jzz()
Dim LR As Long, i As Long, j As Long
Dim c As Range
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Worksheets("Blad1").Range("A1:G" & LR)
      If c.Interior.ColorIndex = 6 Then
            c.Copy Destination:=Worksheets("Blad2").Range("A" & j)
            j = j + 1
        End If
Next c
End Sub

你需要稍微修改一下代码，例如"Blad1"将不存在于你的工作簿中，我只取了ColorIndex = 6