Question

我有这段代码可以根据多个条件将数据从一张表复制到另一张表

我有三张表，即master，jan，feb。我希望片材feb中单元格B5的值应该是单张格式中的单元格H7的值，只有当范围I5：AM中的任何单张格子的单元格为非空白且单格格式中的单元格a5的值为“j”=“WRK”时。向下查看第81行。然后在范围B5：B81中查找第一个空格单元格并选择它如果主表格中范围为O：7：O100的任何单元格的日期位于当前当前月份，则复制单元格b平行于细胞O并粘贴在薄片的第一个空白细胞范围B：5B81中。

Option Explicit

Sub CopyRows()

Dim Cl As Range
Dim str As String
Dim RowUpdCrnt As Long
Dim LR As Long

Sheets("Feb").Range("B5:B81").Value = ""

LR = Cells(Sheets("Feb").Rows.Count, 1).End(xlUp).Row
RowUpdCrnt = 5

' In my test data, the "WRK."s are in column AN.  This For-Each only selects column AN.
' I assume all my "WRK."s are in a single column.  Replace "B" by the appropriate
' column letter for your data.


With Sheets("Jan")
  ' loop until last row with data in Column AN (and not the entire column) to save time
  For Each Cl In .Range("AN1:AN" & .Cells(.Rows.Count, "AN").End(xlUp).Row)
    If Cl.Value Like str And Sheets("Feb").Range(Cl.Address).Value <> "" Then
    'if the cell contains the correct value copy it to next empty row on sheet 2 &  delete the row
      If Not IsError(Application.Vlookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)) Then   ' <-- verify the VLookup was successful
        Sheets("Feb").Range("B" & RowUpdCrnt).Value = Application.Vlookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)
        RowUpdCrnt = RowUpdCrnt + 1
      End If  

      If Application.Worksheets("Feb").Range("I5:AK81") <> "" And Application.Worksheets("Jan").Range("I5:AM81") <> "TRF." Then
        Application.Worksheet("Feb").Range("B5:B81") = Application.Vlookup(Application.Worksheet("Jan").Range("B5"), Application.WorksheetFunction("Master").Range("H7:Q200"), 1, 0).Copy
        With Sheets("Feb").Range("B5").PasteSpecial(xlPasteValues)
          Dim objDate As Date
          Dim ObjDate2 As Date
          'year, month, day
          objDate = DateSerial(1, 1, 2017)
          ObjDate2 = DateSerial(31, 1, 2017)
          If Application.Worksheets("master").Range("H7:H200").Value > ObjDate2 And Application.Worksheets("master").Range("H7:H200").Value < objDate Then      
            If Not IsError(Application.Vlookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)) Then   ' <-- verify the VLookup was successful
              Sheets("Feb").Range("B" & RowUpdCrnt).Value = Application.Vlookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)
              RowUpdCrnt = RowUpdCrnt + 1
            End If
          End If
        End With
        Application.CutCopyMode = False
      End If
    End If
  Next Cl
End With
End Sub

excel vba查找和多个if函数

0 个答案: