有没有更快的方法来比较excel vba中的两个不等的范围?

时间:2015-03-21 02:44:04

标签: excel vba excel-vba

这需要永远执行。有更快的方法吗?

Function add_column_binary(sheet_name_from As String, col_from As Integer, sheet_to As String, col_to As Integer)

'   set range  - the range to be looped through to find key for searching the second range
    Dim first_range As Range

'   set ragen - the range in teh second sheet to be repeatedly searched
    Dim second_range As Range
    Set second_range = set_range(sheet_to, col_to)

'   find last column
    Dim last_col As Integer
    last_col = Worksheets(sheet_to).Cells(1, Columns.Count).End(xlToLeft).column

'   label last column
    Worksheets(sheet_to).Cells(1, last_col + 1).Value = "Invited = 1"

    Dim rows1 As Long
    rows1 = first_range.Cells(rows.Count, col_from).End(xlUp).Row + 1 ' grab the length of the range on the first sheet

    Dim n As Long
    Dim constructed_id As String

    Dim find_result As Range
    For n = 2 To rows1
        constructed_id = "ObjectID(" & first_range.Cells(n, 1) & ")"  ' format object id
        Set find_result = second_range.Find(constructed_id, LookIn:=xlValues, lookat:=xlWhole)
        If Not find_result Is Nothing Then
            Worksheets(sheet_to).Cells(n, last_col + 1) = "1"
        Else
            Worksheets(sheet_to).Cells(n, last_col + 1) = "0"
        End If
    Next n
    Stop

End Function


Sub test_stuff()

    Dim x As Range
      Set x = add_column_binary("invitesOutput.csv", 3, "usersFullOutput.csv", 1)
'    Debug.Print "x = " & x.Address
End Sub

第一个范围是超过8,000个细胞,第二个范围是大约15,000个细胞。

3 个答案:

答案 0 :(得分:0)

看起来很蛮力。我唯一的建议是memoize或许是针对重复的。只需在数组中存储查找值,而不是搜索15,000个单元格,您可以先查看数组。

也许有一种方法可以首先清理输入数据,以便以更有利于搜索的方式构建输入数据?有时你可以吃一次格式化计算来节省搜索量。

答案 1 :(得分:0)

通常更快(在10到100倍之间)将数据放入变体数组并使用它们而不是使用Find。 请参阅此博客文章https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/

如果这还不够快,你可以看看使用词典等:看 https://fastexcel.wordpress.com/2012/07/10/comparing-two-lists-vba-udf-shootout-between-linear-search-binary-search-collection-and-dictionary/

答案 2 :(得分:0)

这是我最终做的事情:

Sub add_column_binary_vlook(sheet_name_from As String, col_from As Integer, sheet_to As String)

'   set range  - the range to be the range in the vlookup
    Dim first_range As Range
    Set first_range = set_range(sheet_name_from, col_from)

'   set range - the range in the second sheet of the first column
    Dim second_range As Range
    Set second_range = set_range(sheet_to, 1)

'   find last column
    Dim last_col As Integer
    last_col = Worksheets(sheet_to).Cells(1, Columns.Count).End(xlToLeft).column

'   set last col formula range
    Dim last_range As Range
    Set last_range = set_range(sheet_to, last_col + 1)


    Dim rows1 As Long
    rows1 = first_range.Cells(rows.Count, col_from).End(xlUp).Row + 1 ' grab the length of the range on the first sheet

    Dim rows2 As Long
    rows2 = second_range.Cells(rows.Count, col_from).End(xlUp).Row + 1 ' grab the length of the range on the second sheet

    With Worksheets(sheet_to)

        last_range.FormulaR1C1 = "=IF(ISNA(VLOOKUP(MID(RC[-16],10,24)," _
            & sheet_name_from & "!R2C" & col_from & ":R" & rows1 & "C" & col_from & ",1,FALSE)),0,1)"

    End With

'   label last column
    Worksheets(sheet_to).Cells(1, last_col + 1).Value = "Invited = 1"

End Sub