Question

我有一个大型数据表，我想搜索并使用VBA放置值。

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

到此表 - 名称：“Schedule Admin”（Sheet2）

我正在尝试让B9，Sheet2搜索并匹配数据库中的名称（A9，Sheet2）（Sheet5，B列），然后将日期（B8，Sheet2）与数据库匹配（Sheet5，A列））。从那里开始，它将粘贴C列（Sheet5）的开放值。

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

我为循环创建了一个基础，它完美地工作..只需要更简单的东西，所以我不必逐个单元地编写这个代码

 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

Answer 1

您需要使用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

根据多个搜索条件查找

1 个答案: