VBA：使用数组searchdynamic数据集条件，并根据interior.colorindex进行复制

这里的示例数据我有单元格，从H8开始，根据数组条件，它应该复制和粘贴那些内部颜色为红色的单元格（单元格必须是红色的，必须有CCA，CUA，SEA，X等string。 ..）代码运行良好，但它不会复制任何东西。 不知道什么使它不能像我打算的那样工作。

现在我想让这个去。 但是，在将来我想为列创build一个dynamic范围。 现在它被设置为第8和第9列进行testing，但一旦开始工作，我将需要它的任何数量的列。

谢谢您的帮助。

Sub BulkUpload() Dim rngCell As Range Dim lngLstRow As Long Dim keywords() As String, maxKeywords() As String Dim totalKeywords As Integer, i& Dim ws As Worksheet, resultsWS As Worksheet ActiveSheet.Name = "FileShares" Set ws = Sheets("Sheet1") Set resultsWS = Sheets("FileShares") totalKeywords = 6 ReDim keywords(1 To totalKeywords) ReDim maxKeywords(1 To totalKeywords) maxKeywords(1) = "SEA" maxKeywords(2) = "CUA" maxKeywords(3) = "CCA" maxKeywords(4) = "CAA" maxKeywords(5) = "AdA" maxKeywords(6) = "X" lngLstRow = ws.UsedRange.Rows.Count Dim k& For k = 8 To 9 With ws For Each rngCell In .Range(.Cells(8, k), .Cells(lngLstRow, k)) For i = LBound(maxKeywords) To UBound(maxKeywords) If maxKeywords(i) = rngCell.Interior.ColorIndex = 5 Then resultsWS.Cells(65536, k).End(xlUp).Offset(1, 0).EntireRow.Value = rngCell.EntireRow.Value End If Next i Next rngCell End With Next k End Sub 

Answer 1

部分问题是，您正在使用Interior.ColorIndex = 5.此MSDN网站有一个ColorIndex列表和5是蓝色。 你提到你正在寻找红色