VBA索引/符合多个条件(唯一值和日期)

时间:2016-04-19 18:25:47

标签: excel vba excel-vba

我的电子表格的值超过一个月,因此我首先尝试根据wsRevFile工作表中的值找到该值,然后确保这是上个月的值。当我使用下面的代码时,我得到一个"无效数量的参数"错误。

Sub RevLookup(wsMvFile As Worksheet, wsRevOld As Worksheet, wsNewRev As Worksheet, _
                        rowCount As Integer, workCol As String, _
                        srcCol1 As Integer, srcCol2 As Integer)

Dim vrw As Variant, i As Long

For i = 2 To rowCount
    vrw = Application.Match(wsRevFile.Range("A" & i), wsNewRev.Columns(2), Format(DateSerial(Year(Date), Month(Date), 0), "mm/dd/yyyy"), wsNewRev.Columns(1), 0)
    If IsError(vrw) Then
        vrw = Application.Match(wsRevFile.Range("A" & i), wsRevOld.Columns(1), 0)
        If Not IsError(vrw) Then _
            wsRevFile.Range(workCol & i) = Application.Index(wsRevOld.Columns(srcCol1), vrw)
    Else
        wsRevFile.Range(workCol & i) = Application.Index(wsNewRev.Columns(srcCol2), vrw, 1)
    End If
Next i
End Sub

我假设这与我分配应用程序匹配功能的方式有关,因为没有此部分的公式适用于其他列。关于如何让它发挥作用的任何想法?

感谢您的帮助!

1 个答案:

答案 0 :(得分:1)

尝试调整以下过程的变量,因为我没有弄清楚你的输入和输出数据:

Sub Main()
Dim SearchValue As Variant
Dim SearchColumn As Range
Dim ReturnColumn As Range
Dim ResultRows As Collection
Dim LastDate As Variant 'Date?
Dim iRow As Variant

SearchValue = 10 '<-- change to suit
Set SearchColumn = wsNewRev.Range("B1:B10")
Set ReturnColumn = wsNewRev.Range("C1:C10") '<-- change to suit

Set ResultRows = GetLoopRows(SearchColumn, SearchValue)
For Each iRow In ResultRows
    If LastDate < ReturnColumn(iRow) Then
        LastDate = ReturnColumn(iRow)
    End If
Next iRow

Debug.Print LastDate
End Sub

Function GetLoopRows(ParamArray pParameters() As Variant) As Collection
'Obtém limites de laços com levando em conta condições
'[vetor1], [valor1], [vetor2], [valor2], ...

Dim iCondition As Long
Dim i As Variant
Dim iRow As Variant
Dim Result As Collection
Dim NumConditions As Long
Dim SearchCollection As Collection
Dim ArraysCollection As Collection
Dim iArray As Variant

NumConditions = (UBound(pParameters) - LBound(pParameters) + 1) / 2
Set ArraysCollection = New Collection
Set SearchCollection = New Collection
For i = LBound(pParameters) To UBound(pParameters) Step 2
    ArraysCollection.Add pParameters(i + 0).Value2
    SearchCollection.Add pParameters(i + 1)
Next i

Set Result = New Collection
For iRow = LBound(ArraysCollection(1)) To UBound(ArraysCollection(1))
    For iCondition = 1 To NumConditions
        If ArraysCollection(iCondition)(iRow, 1) <> SearchCollection(iCondition) Then GoTo Continue
    Next iCondition
    Result.Add CLng(iRow)
Continue:
Next iRow
Quit:
Set GetLoopRows = Result
End Function