使用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）等

希望這會給您一個開始。 如果可以的話，只需按程序考慮每一行。