vba:使用两个条件标识行，并从行返回其他数据-vba:Identifyrowusing2criteriaandreturnotherdatafromrow

I am trying to find code that looks at two criteria in spreadsheet1 and finds a row that corresponds in spreadsheet2 and returns a third piece of data in spreadsheet2 to spreadsheet1. I need to do this in vba because it loops, because I will be done it again and again, and because the data from spreadsheet2 imports from another database and will change over time. If possible it would be nice if the code also allowed for identifying a 3rd criteria on spreadsheet2.

我正在寻找查看spreadsheet1中的两个标准的代码，并在spreadsheet2中找到一个对应的行，并将spreadsheet2中的第三个数据返回到spreadsheet1。我需要在vba中这样做，因为它是循环的，因为我将一次又一次地这样做，而且因为来自spreadsheet2的数据从另一个数据库中导入，并且随着时间的推移会发生变化。如果可能的话，如果代码还允许识别电子表格2上的第三个标准，那就太好了。

Example is: Spreadsheeet 1

的例子是:Spreadsheeet 1

 Product ID  ActCode: A0003
 11111
 12345
 22222
 ...

Spreadheet 2

Spreadheet 2

ProductID  ActivityCode   DateDue
 11111     A0001          7/15/15
 11111     P7530          7/30/15
 11111     A0003          8/1/15
 12345     A0003          12/15/15
 12345     A0007          1/1/15
 22222     A0001          2/1/15 
 ...

Where I want Spreadsheet1 to end up:

我希望Spreadsheet1到此结束:

Spreadsheeet 1

Spreadsheeet 1

 Product ID  ActCode: A0003
 11111       8/1/15
 12345       12/15/15
 22222         - 
 ...

I have tried a ton of things over the past few days. 1) vlookup/index/match combos that have never really worked, 2) filtering spreadsheet2 by productID and activitycode and then copying to spreadsheet1 the visible cells - this works but is very slow. I will be doing this for many activity codes, so I need something faster (I can post the code if you want to see it). I am currently trying a loop within a loop. Not sure if this is the best way but here is the code I have so far. It does copy some dates over, but not the right ones - its also a bit slow.

在过去的几天里我尝试了很多东西。1)vlookup/index/match combos，它们从未真正起作用，2)通过productID和activitycode进行过滤，然后复制到可视单元——这是可行的，但速度非常慢。我将对许多活动代码执行此操作，因此我需要一些更快的东西(如果您想看的话，我可以发布代码)。我现在正在循环中尝试一个循环。不确定这是否是最好的方法，但这是我到目前为止的代码。它确实复制了一些日期，但不是正确的日期-它也有点慢。

Sub test()

Application.ScreenUpdating = False
  Sheets("Spreadsheet1").Select

  Range("A2").Select ' Select A = the column with the product ID in it
  ' Set Do loop to stop when an empty cell is reached.
  Do Until IsEmpty(ActiveCell)

    Dim ConceptAct  As String
    COnceptAct= "A0003"

    Dim ProductID
    ProductID = ActiveCell.Value
    Dim ConcDue

        Sheets("Spreadsheet2").Select
        Range("A2").Select 'The column with the ProductID in it

        Do Until IsEmpty(ActiveCell)

        If ActiveCell.Value = ProductID And ActiveCell.Offset(0, 1).Value = ConceptAct Then

            COncDue= ActiveCell.Offset(0, 2).Value

            Exit Do
        End If
           ActiveCell.Offset(1, 0).Select
        Loop

     Sheets("Spreadsheet1").Select

     ActiveCell.Offset(0, 1) = ConcDue

     ' Step down 1 row from present location.
     ActiveCell.Offset(1, 0).Select

  Loop

Application.ScreenUpdating = True

End Sub

2 个解决方案

Function udf_Get_Two(sCode As Range, rCodes As Range, _
                     sProd As Range, rProds As Range, _
                     rDates As Range)
    Dim vCode As Variant, rw As Long, m As Long

    'quick check to see if there is anything to find
    If CBool(Application.CountIfs(rCodes.Columns(1), sCode.Value, _
      rProds.Resize(rCodes.Rows.Count, 1), sProd.Value)) Then
        rw = 0
        For m = 1 To Application.CountIf(rCodes.Columns(1), sCode.Value)
            rw = rw + Application.Match(sCode.Value, rCodes.Columns(1).Resize(rCodes.Rows.Count - rw, 1).Offset(rw, 0), 0)
            If rProds(rw, 1) = sProd Then
                udf_Get_Two = rDates.Cells(rw, 1).Value
                Exit Function
            End If
        Next m
    End If

End Function

=udf_Get_Two(A2, Sheet2!$A$2:$A$7, $C$1, Sheet2!$B$2:$B$7, Sheet2!$C$2:$C$7)