Vba 基于多个搜索条件查找

我有一个大的数据表，我想用VBA搜索和放置值

工作表与日程安排有关，我想从该电子表格中提取员工日程安排-名称：“数据库”（Sheet5）：

至本页-名称：“日程管理”（第2页）

我试图让B9，Sheet2搜索并匹配数据库（Sheet5，B列）中的名称（A9，Sheet2），然后将日期（B8，Sheet2）匹配到数据库（Sheet5，A列）。从那里开始，它将粘贴C列（第5页）中的开口值

起初我考虑了一个公式，但我希望用户编辑它，因为我有一个“保存到数据库”按钮

我为循环创建了一个基础，它工作得非常完美。。只是需要一些更简单的东西，这样我就不必一个单元格一个单元格地编写代码了

 Sub Load()
    Dim dtFrom As String
    Dim LoadDate As String
    Dim y As Long
    Dim i As Long
    Dim vCont As Variant
    Dim iCont As Variant
    Dim Result As Variant
    dtFrom = Sheets("Schedule Admin").Range("A9").Value
    LoadDate = Sheets("Schedule Admin").Range("B8").Value
    With Sheets("Schedule Admin")
        For y = 27 To 9 Step -3
            vCont = .Cells(y, 1).Value
            If Not IsError(vCont) Then
                If vCont = dtFrom Then
                With Sheets("Database")
                    For i = 100 To 2 Step -1
                        iCont = .Cells(i, 1).Value
                        If Not IsError(iCont) Then
                            If iCont = LoadDate Then
                                If vCont = Sheet5.Range("B" & i).Value2 Then
                                Result = Sheet5.Range("C" & i).Value2
                                Sheet2.Range("B9").Value2 = Result
                                End If
                            End If
                        End If
                        Next
                        End With
                End If
            End If
        Next
    End With
End Sub

---

您需要在x上工作以计算出正确的小时数，但这将得到您想要的结果

Sub DoIt()
    Dim sh As Worksheet, ws As Worksheet
    Dim fr As Range    'range to filter
    Dim nRng As Range, Crng As Range, c As Range, Lrw As Long, r As Range, x

    Set ws = Sheets("Database")
    Set sh = Sheets("Schedule Admin")
    Set fr = sh.Range("A9")

    With ws
        .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=fr
        lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set nRng = .Range("A3:A" & lrow).SpecialCells(xlCellTypeVisible)
    End With

    With sh
        Set Crng = .Range("B8:H8")
        For Each c In Crng.Cells
            Set r = nRng.Find(what:=c.Value, lookat:=xlWhole)
            If Not r Is Nothing Then
                x = ws.Range("D" & r.Row) - ws.Range("C" & r.Row)    'calculate hours
                c.Offset(1) = x
            Else: MsgBox "Not Found"
            End If
        Next c
    End With


End Sub

---

从页面右上角的搜索框开始。键入excel VBA Find Multiple，您将得到答案您的方法会破坏您的数据。除非用户编辑数据库工作表上的信息，并根据该信息填充Sheet2，否则Sheet2上的数据是无用的。@Jeeped我理解您试图说什么来解决数据库工作表中的问题。这更像是一周一周的日程安排的视觉编辑。它有一个删除旧保存和保存新保存的代码。我创建了一个搜索和查找日期的基础。。现附上。