Question

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

我想创建一个宏来复制第1页和第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

你的情况
.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 2

更新：以下代码已修改为跳过黄色突出显示的空格...

我可能将这个分为两部分，一个执行循环遍历工作表的脚本和一个检查单元格（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 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

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

3 个答案: