使用vlookup复制数据，如果

Question

我有一个效果很好的代码，但我想做一些修改

工作表“ feb”中的单元格B5的值If sheets("Feb").Range("I5:AK81)<>"" （如果范围中的任何单元格If sheets("Feb").Range("I5:AK81)<>""空白，而Sheets("Jan").Range("I5:AM81")不等于“ TRF。”意味着如果范围内的任何单元格都不等于“ TRF。”，则在范围Sheets("master").Range("H7:Q200"),1,0)中的表“ Jan”中的VLookup单元格B5 Sheets("master").Range("H7:Q200"),1,0)复制并粘贴到表格“ Feb”的单元格B5中。

并转到工作表2月的B5：B81范围中的最后一个空白列，如果Sheets（“ master”）的O列中有任何日期。Range（“ H7：q200”）仅在当年的当前月份内，然后复制适当的单元格b在范围内，然后粘贴到工作表“ Feb”范围B5：B81的最后一个空单元格中，依此类推

下面是代码

Option Explicit

Sub CopyRows()

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

str = "WRK.*" 'string to look for
Sheets("Feb").Range("B5:B81").Value = ""

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
    End If
  Next Cl
End With

Application.CutCopyMode = False
End Sub

Answer 1

If AND(criteria1,critieria2) then

这应该允许您使用第二个条件，而不需要嵌套另一个if语句。

很难遵循您要走的方向，所以如果这是错误的，请纠正我。 还没有完全做到这一点，但是我们可以尝试分解其中的一些：

.1），然后在范围Sheets（“ master”）。Range（“ H7：Q200”），1,0）中的“ Jan”表中的VLookup单元格B5

'You've got this.  I would recommend index/match 
'using application and worksheet function commands.

.2）复制并粘贴到“ Feb”表的单元格B5中。

With Sheets("Feb").Range("B5").PasteSpecial xlPasteValues

.3）转到2月表单B5：B81范围内的最后一个空白列

Dim LR as Long 'LR is last row
LR = Cells(Sheets("Feb").Rows.Count, 1).End(xlUp).Row

.4）如果Sheets（“ master”）。Range（“ H7：q200”）的O列中的任何日期仅在当年的当前月份内

'Assuming this sheet based... Assuming H is the date column
If Sheets("master").Range("H7:H200").Value = "2" Then

.4a）然后复制范围内的适当单元格b

'use index/match with output being Column(2)/B
WorksheetFunction.Index(rangeB,WorksheetFunction.Match(reference,rangeH)).Copy

.4b）粘贴到工作表“ Feb”范围B5：B81的最后一个空单元格中

Sheets("Feb").Cells(LR+1,2).PasteSpecial xlPasteValues

.5）等

希望这会给您一个开始。 如果可以的话，只需按程序考虑每一行。