Question

我从谷歌找到了这个查找vba，我做了一些修改。但是，我很难找到解决复制相同任务编码问题的方法（下面解释）我的目标是查找一个值并一次返回多个值。以下是我的一些步骤：

原始数据表（数据分析）是从C8到O399
查询值从A5到A172，返回结果放在T5到T172（在工作表名称“Graph”处）
然后我再次重复下一次查找，重复步骤1和2中的测试代码，略有不同的列
我再次明确从C8到I399的原始数据表（数据分析） - *与第1步不同的列
查找值从A5到A172，然后返回结果放在V5到V172（在工作表名称“Graph”处）
我再次重复1和2，直到我完成所有多次返回的查询（大约15个值）

所以我很难把它放到循环中，因为每次查找都会改变列和表的值。

原始数据的两列查找表仅允许每个查找任务（这与我需要特定要查找的列的vkloop不同）我想补充的另一点是原始数据可能会达到几千行，我看到这段代码正在使用“集合”进行存储。我不知道这是为了什么。

以下是编码

Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)
    Dim i As Long, resArr() As Variant
    ReDim resArr(lookupCategory.Rows.Count, 1)
    For i = 1 To lookupCategory.Rows.Count
        resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
    Next i
    lookupValues = resArr
End Sub

非常感谢任何帮助。感谢。

Sub TestVBA()
OptimizeVBA True
Dim startTime As Single, endTime As Single
startTime = Timer

Dim testnames As Range, testvalues As Range
Dim lookupTestNames As Range, lookupTestValues As Range
Dim vlookupCol As Object



Set testnames = Worksheets("Data Analysis").Range("C8:C399")
Set testvalues = Worksheets("Data Analysis").Range("O8:O399")
   Set lookupTestNames = Worksheets("Graph").Range("A5:A172")
Set lookupTestValues = Worksheets("Graph").Range("T5:T172")

'Set testvalues = Worksheets("Data Analysis").Range("I8:I" & 399)
'Set lookupTestNames = Worksheets("Graph").Range("A5:A172")
'Set lookupTestValues = Worksheets("Graph").Range("U5:U172")

'Build Collection
Set vlookupCol = BuildLookupCollection(testnames, testvalues)

'Lookup the values
'VLookupValues lookupTestNames, lookupTestValues, vlookupCol
VLookupValues lookupTestNames, lookupTestValues, vlookupCol
endTime = Timer
Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
OptimizeVBA False
Set vlookupCol = Nothing

'For Lower Test Spec****************************************************************
Set testnames = Worksheets("Data Analysis").Range("C8:C" & 399)
Set testvalues = Worksheets("Data Analysis").Range("I8:I" & 399)
Set lookupTestNames = Worksheets("Graph").Range("A5:A172")
Set lookupTestValues = Worksheets("Graph").Range("U5:U172")

'Build Collection
Set vlookupCol = BuildLookupCollection(testnames, testvalues)

'Lookup the values
VLookupValues lookupTestNames, lookupTestValues, vlookupCol
endTime = Timer
Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
OptimizeVBA False
Set vlookupCol = Nothing

'For Upper Test Spec****************************************************************

Set testnames = Worksheets("Data Analysis").Range("C8:C" & 399)
Set testvalues = Worksheets("Data Analysis").Range("J8:J" & 399)
Set lookupTestNames = Worksheets("Graph").Range("A5:A172")
Set lookupTestValues = Worksheets("Graph").Range("V5:V172")

'Build Collection
Set vlookupCol = BuildLookupCollection(testnames, testvalues)

'Lookup the values
VLookupValues lookupTestNames, lookupTestValues, vlookupCol
endTime = Timer
Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
OptimizeVBA False
Set vlookupCol = Nothing

Answer 1

阿里有正确的方法。具有列对的查找数组将使循环更容易。

Sub TestVBA2()
    OptimizeVBA True
    Dim startTime As Single
    Dim cSet, vlookupCol As Object

    For Each cSet In Array(Array("I", "T"), Array("J", "U"), Array("O", "V"))
        startTime = Timer

        With Worksheets("Data Analysis").Rows("8:399")
            Set vlookupCol = BuildLookupCollection(.Columns("C"), .Columns(cSet(0)))
        End With

        With Worksheets("Graph").Rows("5:172")
            VLookupValues .Columns("A"), .Columns(cSet(1)), vlookupCol
        End With

        Debug.Print Timer - startTime, "Data Analysis Column:"; cSet(0), "Graph Column:"; cSet(1)
    Next

    OptimizeVBA False

End Sub

具有重复任务的vba中的Vlookup函数

1 个答案: