使用数组

Question

我需要根据多种条件为多种商品定义最佳匹配 该范围基于大量行（至少约5000个）和许多列：特别是，Family，Pivot Code，Selection，Quantity，Reference 1，Price 1，Reference 2，Price 2，... 引用列可以更改（可以有2个或第n个引用） 对于Family和Pivot Code的每个组合，我需要找到具有最大数量和参考价格1的行 如果没有参考价格为1的Family / Pivot Combination，我会查看是否有参考价格2等 如果没有任何参考价格的家庭/枢轴组合，我将寻找最高数量，尽管参考价格等 为了减少复杂性，我在许多公式中拆分了一个巨大的公式，就像这个一样

 IFERROR(MATCH(1;($A$2:$A$20=$M2)*($B$2:$B$20=$N2)*($F$2:$F$20=LARGE(IF($A$2:$A$20=$M2;IF($B$2:$B$20=$N2;IF($H$2:$H$20<>"";IF($F$2:$F$20<>"";$F$2:$F$20))));1));0)&"-Reference";FALSE)

我的问题是，由于行数很多，在excel表中应用公式将花费太多时间，以及应用Evaluate函数。 然后，我想尝试使用数组，但我无法找到使其正常工作的正确方法。这是我到目前为止创建的部分代码（其他＆＃39;如果＆＃39;条件仍然缺失，我还必须添加Countif函数，这也会减慢进程）

Sub comparearray()
Dim test As Boolean
Dim familyrng, pivotrng, xrng, qtyrng, ref1rng, ref2rng, relrefrng, rangeM, rangeN, Ranges
Dim ws As Worksheet
Dim c As Range
Dim formtest
Dim Count
Dim a, b
Dim i, rws, CustMax, k As Long
Dim Max As Long
Dim t As Single


Set ws = Sheets("Sheet1")
ws.Select
lr = ws.Range("A1048576").End(xlUp).Row
lr1 = ws.Range("M1048576").End(xlUp).Row
'lc = .cells(20, Columns.Count).End(xlToLeft).Column

familyrng = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 1), Cells(lr, 1)).Value
Set familyrange = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 1), Cells(lr, 1))
pivotrng = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 2), Cells(lr, 2)).Value
Set pivotrange = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 2), Cells(lr, 2))
xrng = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 3), Cells(lr, 3)).Value
Set xrange = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 3), Cells(lr, 3))
qtyrng = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 4), Cells(lr, 4)).Value
Set qtyrange = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 4), Cells(lr, 4))
ref1rng = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 6), Cells(lr, 6)).Value
Set ref1range = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 6), Cells(lr, 6))
ref2rng = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 8), Cells(lr, 8)).Value
Set ref2range = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 8), Cells(lr, 8))
relrefrng = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 9), Cells(lr, 9)).Value
Set relrefrange = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 9), Cells(lr, 9))

rangeM = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 13), Cells(lr1, 13)).Value
rangeN = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 14), Cells(lr1, 14)).Value
Ranges = ThisWorkbook.Sheets("Sheet1").Range(Cells(2, 15), Cells(lr1, 15)).Value


t = Timer

rws = UBound(familyrng, 1)
rws1 = UBound(rangeM, 1)
rownum = 0
For k = 1 To rws1
Cust = rangeM(k, 1)
Cust1 = rangeN(k, 1)
Cust3 = Ranges(k, 1)

If Application.WorksheetFunction.CountIfs(familyrange, Cust, pivotrange, Cust1, qtyrange, "<>""", ref1range, "<>""") > 0 Then
'Application.WorksheetFunction.CountIfs(familyrng, Cust, pivotrng, Cust1, qtyrng, "<>""", ref1rng, "<>""") > 0
For i = LBound(familyrng) To UBound(familyrng)

    If familyrng(i, 1) = Cust And pivotrng(i, 1) = Cust1 And qtyrng(i, 1) <> "" And ref1rng(i, 1) <> "" Then
    If qtyrng(i, 1) > CustMax Then
    CustMax = qtyrng(i, 1) And rownum = i
    'Debug.Print CustMax
    End If
    End If
    Next i
    Cells(k + 1, 15) = rws & "-Reference"
Else
If Application.WorksheetFunction.CountIfs(familyrange, Cust, pivotrange, Cust1, ref1range, "<>""", xrange, "x") > 0 Then
For i = 1 To rws

    If familyrng(i, 1) = Cust And pivotrng(i, 1) = Cust1 And qtyrng(i, 1) <> "" And ref1rng(i, 1) <> "" And xrng = "x" Then
    rownum = i
    End If
    Next i
    Cells(k + 1, 15) = rownum & "No Runner-refetitor"

End If
End If
Next k
Debug.Print Format(Timer -t, "0.000000000 secs")
End Sub

你能说出我的方法是否最快，如果是，我怎样才能定义哪个是最佳匹配单元的行号（在我的代码中'rownum = i'）