2015-09-30 288 views
-1

我有一个很大的数据表,我想用VBA搜索和放置值。根据多个搜索条件查找

工作表与调度做的,我想拉一个员工从该电子表格计划 - 名称:“数据库”(Sheet5):

enter image description here

这个片状名称:“计划管理员”(Sheet2的)

enter image description here

我试图让B9,Sheet2的搜索和匹配数据库名称(A9,Sheet2的)(Sheet5,列B),然后匹配日期(B8 ,Sheet2)到数据库e(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 
+2

从此页面右上角的搜索框开始。输入excel VBA Find Multiple,你会得到你的答案 – Sorceri

+0

你的方法会破坏你的数据。除非用户编辑数据库工作表上的信息并且从中填充Sheet2,否则Sheet2上的数据无用。 – Jeeped

+0

@Jeeped我明白你想说出什么来解决数据库表。它更像是一周一周的时间表的可视化编辑。它有一个代码,用于删除旧的保存并保存新的保存。我创建了一个搜索和查找日期的基础。现在附上。 – hinteractive02

回答

0

您将需要在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