Question

Sample data here我有单元格从H8开始并基于数组条件，它应该复制并粘贴内部颜色为红色的单元格（单元格必须是红色的，并且必须包含CCA，CUA，SEA的字符串，X等....）代码运行正常，但它不会复制任何东西。不知道是什么让它无法正常运作。

现在我想让这一切顺利。但是在将来，我想为列创建一个动态范围。现在它已设置为第8列和第9列进行测试，但一旦开始工作，我就需要它到任意数量的列。

感谢您的帮助。

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是蓝色。你提到你在寻找红色

VBA：使用数组搜索动态数据集条件并基于interior.colorindex进行复制

1 个答案: