使用vlookup复制数据，如果 [英] copy data using vlookup and if

问题描述

我有一个运行良好的代码，但我想做一些修改

I have a code which works good but i want some modifications as

工作表"feb"中单元格B5的值 Ifsheets("Feb").Range("I5:AK81)<>""(如果范围内的任何单元格都不为-blank和 Sheets("Jan").Range("I5:AM81")不等于"TRF."表示范围内的任何单元格都不等于"TRF".然后在工作表"Jan"中的 VLookup 单元格B5中将 Sheets("master").Range("H7:Q200")，1,0)范围复制并粘贴在工作表"Feb"的单元格B5中.

Value of cell B5 in Sheet "feb" If sheets("Feb").Range("I5:AK81)<>"" (if any of the cell in range is none-blank and Sheets("Jan").Range("I5:AM81") is not equal to "TRF." means if any of the the cell in range is not equal to "TRF." then VLookup cell B5 in sheet "Jan" in range Sheets("master").Range("H7:Q200"),1,0) and copy it and paste in cell B5 of sheet "Feb".

并转到工作表2月的B5:B81范围中的最后一个空白列，并且如果Sheets("master")的O列中有任何日期.Range("H7:q200")仅落在当年的当前月份之内，然后复制该范围内的适当单元格b并粘贴到工作表"Feb"范围B5:B81的最后一个空单元格中，依此类推

and go to last blank column in range B5:B81 of sheet feb and if any of date in column O of Sheets("master").Range("H7:q200") falls only within current month of current year then copy appropriate cell b in the range and paste in last empty cell of sheet "Feb" range B5:B81 and so on

下面是代码

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

推荐答案

If AND(criteria1,critieria2) then

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

This should allow you a second criteria, and not need to nest another if statement.

有点难以遵循您要走的方向，因此，如果这是错误的，请纠正我.尚不能完全理解这一点，但我们可以尝试分解其中的一部分:

Kind of hard to follow the direction you're going, so correct me if this is wrong. Not quite getting the "so on" part of this, but we can try to break down some of this:

.1)，然后在工作表Sheets("master").Range("H7:Q200")，1,0)的范围内的工作表"Jan"中VLookup单元格B5

.1) then VLookup cell B5 in sheet "Jan" in range Sheets("master").Range("H7:Q200"),1,0)

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

.2)复制并粘贴到工作表"Feb"的单元格B5中.

.2) copy it and paste in cell B5 of sheet "Feb".

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

.3)转到2月工作表B5:B81范围内的最后一个空白列

.3) go to last blank column in range B5:B81 of sheet feb

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列中的任何日期仅在当年的当前月份之内

.4) if any of date in column O of Sheets("master").Range("H7:q200") falls only within current month of current year

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

.4a)，然后复制范围

.4a) then copy appropriate cell b in the range

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

.4b)粘贴到工作表"Feb"范围B5:B81的最后一个空单元格中

.4b) paste in last empty cell of sheet "Feb" range B5:B81

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

.5)如此

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

This will hopefully give a start to you. Just think about each line procedurally, if you can.

这篇关于使用vlookup复制数据，如果的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！