搜索列中的每个单元格以查找特定值，并从该值所在的行中的另一个单元格复制值

Question

我有一个表放在一起作为数据库。 我正在尝试编写宏以在表中搜索“系统大小”列以查找“ 2500”，然后搜索“标准”列以查找“标准”，然后搜索“类别”列以查找“ FL”，然后我想从选择与在另一张纸中找到这些值的行相关的项目列。 例如，宏将在列E（系统大小）中搜索所有“ 2500”，然后在列F（标准）中搜索所有“标准”，然后将在列G（类别）中搜索所有“ FL”。 然后，我希望它为满足这些要求的每一行从C列（选择项）中复制值，并将其粘贴到另一张纸上。 以下是我到目前为止的代码，但是我只能获取它来搜索一个单元格而不是整个列。 可能有更好的解决方法，但这是我发现可行的唯一方法。

Sub ImDoingMyBest()
'
' ImDoingMyBest Macro
'

'
    If Sheets("Database").Range("E2").Value Like "*2500*" Then
    Sheets("Database").Range("C2").Copy
    Sheets("Quote Sheet").Select
    Range("B26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End If
End Sub

Answer 1

搜索整列的方法是使用for循环。 例如：

For i  = 1 To 10000

    If Sheets("Database").Range("E" & i).Value Like "*2500*" Then

        Sheets("Database").Range("C" & i).Copy
        ...
        ...

    End If

Next i

另外（根据我的喜好）也可以使用Cells（ row ， column ）格式，而不要使用Range-这样就不必连接Range引用。 这需要

Range("E" & i)

并更改为

Cells(i, 5)

这是整洁代码（IMO）。

Answer 2

在Siddarth Rout的评论之后，下面的代码使用Autofilter隔离“数据库”工作表中符合您条件的行，然后将C列中的相应值复制到名为“ Quote Sheet”的工作表单元格B26中的范围。 ”。

Sub FilterAndCopy()

    Dim dataWs As Worksheet
    Dim copyWs As Worksheet
    Dim totRows As Long
    Dim lastRow As Long

    Set dataWs = Worksheets("Database")
    Set copyWs = Worksheets("Quote Sheet")

    With dataWs
        .AutoFilterMode = False
        With .Range("C:G")
             .AutoFilter Field:=3, Criteria1:="2500"
             .AutoFilter Field:=4, Criteria1:="Standard"
             .AutoFilter Field:=5, Criteria1:="FL"
        End With
    End With

    totRows = dataWs.Range("C:C").Rows.count
    lastRow = dataWs.Range("C" & totRows).End(xlUp).Row
    dataWs.Range("C2:C" & lastRow).Copy
    copyWs.Range("B26").PasteSpecial Paste:=xlPasteValues
    dataWs.AutoFilterMode = False

End Sub