2017-08-01 55 views
0

我正在研究一个由一系列表格和几个宏组成的大型项目。我需要逐月更新的主要报告是21K行,并在不断增长。它在12个独立的专栏中收集所有12个月的更新。要完成“更新”,我必须匹配包含在列“A”中的主文件中的部件号(21k行是所有部件号及其信息),并将其与部件号生成的另一报告相匹配(此时包含在柱9 sht1的代替Vlookup找到大20k行表吗?

地点的值由变量

地点指定列7 sht1的值设置为SHT柱:柱“B”),并且如果它匹配(需要被精确匹配),下面的返回SHT柱27

地点塔11 SHT 1至SHT柱34

每次匹配时

的值,由RO循环排w,直到列A中包含的最后一个零件编号在sht中。

下面的代码有效,但我想知道是否有更好的方法我应该写这个?这对于处理速度和准确性来说是最好的吗?我刚刚在另一个代码块中意识到,这种方法没有执行完全匹配,现在已经抛出了一面红旗,可能会改变我的方法。我绝对需要这样做是准确的,它必须完全匹配,或者将内容留空。

'Set variable with cell range value for ABC Code based on month selected by User 

Dim ABCCodeCell As Integer 
Dim wb1 As Workbook 
Dim wb2 As Workbook 
Dim sht1 As Worksheet 
Dim sht As Worksheet 
Dim lRow As Long 
Dim rng As Range 

Set wb1 = Workbooks(vFileName1) 'ABC Matrix File 
Set wb2 = Workbooks(vFileName2) 'Cycle Count Remainder Browse File 
Set sht = wb1.Worksheets(1) 'ABC Matrix File 
Set sht1 = wb2.Worksheets(1) 'Cycle Count Remainder Browse File 

lRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row 

Select Case ABCMatrixMonthSelect.ComboBox1.value 
    Case "January": ABCCodeCell = 21 
    Case "February": ABCCodeCell = 23 
    Case "March": ABCCodeCell = 25 
    Case "April": ABCCodeCell = 3 
    Case "May": ABCCodeCell = 5 
    Case "June": ABCCodeCell = 7 
    Case "July": ABCCodeCell = 9 
    Case "August": ABCCodeCell = 11 
    Case "September": ABCCodeCell = 13 
    Case "October": ABCCodeCell = 15 
    Case "November": ABCCodeCell = 17 
    Case "December": ABCCodeCell = 19 
End Select 

'Execute Find (Vlookup) 


On Error Resume Next 
For i = 2 To lRow 
If sht.Cells(i, 1).value <> "" Then 
    Set rng = sht1.Range("B:B").Find(sht.Cells(i, 1).value) 
    If Not rng Is Nothing Then 
     sht.Cells(i, ABCCodeCell).value = sht1.Cells(rng.Row, 9).value 
     sht.Cells(i, 27).value = sht1.Cells(rng.Row, 7).value 
     sht.Cells(i, 34).value = sht1.Cells(rng.Row, 11).value 
    End If 
End If 
Next 
+0

@Tim Williams就是这样。我只是不得不重写它,因为我之前发布过它,但没有人回复,所以我在几天后删除了它。谢谢! - 雅典娜,又名SharePoint0508 – SharePoint0508

+3

它对我来说看起来不错...目前它运行速度太慢吗?你是否在使用'Application.ScreenUpdating = False,Application.Cursor = xlWait'等等?有什么特别不起作用?这对Code Review来说可能是一个更好的问题。 – dwirony

+0

*我刚刚在另一个代码块中实现,这种方法没有执行完全匹配,*,这是什么意思? – dwirony

回答

1

我不会在你的代码是否是速度等最佳的代码注释,因为这是不是真的对话题的堆栈溢出 - 这些类型的问题应该在Code Review询问。

我会然而答案再你的“(必须是精确匹配)”的评论:

的Excel允许用户指定各种选项进行查找时:

enter image description here

大多数(所有? )这些选项在下一次查找时会被记住并默认使用,可以是由用户执行的手动查找,也可以是VBA代码中已编程的Find

您当前的发现(sht1.Range("B:B").Find(sht.Cells(i, 1).value))不指定除What参数以外的任何参数,因此会使用任何用户上次使用的LookInLookAtMatchCase参数的值。

如果您想执行完全匹配,并且您不相信用户在运行代码之前没有完成部分匹配,则应明确指出您希望使用的选项。

我建议你改变你的Find是:

Set rng = sht1.Range("B:B").Find(What:=sht.Cells(i, 1).Value, _ 
           LookIn:=xlValues, _ 
           LookAt:=xlWhole, _ 
           MatchCase:=True) 
1

在大循环中运行Find()是相当缓慢相比,使用Match()

例如,在20000的不同值的列中查找2000个值:

Sub Tester() 

    Dim i As Long, f As Range, t, m, n As Long 

    t = Timer 
    For i = 1 To 2000 
     Set f = Columns(1).Find(what:="Prod_" & Format(i, "000000"), _ 
           lookat:=xlWhole, LookIn:=xlValues) 
     If Not f Is Nothing Then 
      n = n + 1 
     End If 
    Next i 
    Debug.Print "Find", Timer - t, "found " & n 

    t = Timer 
    n = 0 
    For i = 1 To 2000 
     m = Application.Match("Prod_" & Format(i, "000000"), Columns(1), 0) 
     If Not IsError(m) Then 
      n = n + 1 
      'here m = the row with the matched value, so copy from this row 
     End If 
    Next i 
    Debug.Print "Match", Timer - t, "found " & n 

End Sub 

输出:

Find   19.75781  found 2000 
Match   1.46875  found 2000 
+0

如果您首先将搜索范围读入数组,那么匹配会更快吗? – YowE3K

+0

嗯 - 看起来不是 - 我得到14.32的查找,1.11匹配和13.06匹配数组(与时间读取到数组显示为0) – YowE3K

+0

@ YowE3K - 匹配更快(约10倍)反对工作表比数组(编辑:你已经想出了) –

0

如果SHT尚未式电池,使用变量数组更快。

Sub test() 
'Set variable with cell range value for ABC Code based on month selected by User 

    Dim ABCCodeCell As Integer 
    Dim wb1 As Workbook 
    Dim wb2 As Workbook 
    Dim sht1 As Worksheet 
    Dim sht As Worksheet 
    Dim lRow As Long 
    Dim rng As Range 

    Set wb1 = Workbooks(vFileName1) 'ABC Matrix File 
    Set wb2 = Workbooks(vFileName2) 'Cycle Count Remainder Browse File 
    Set sht = wb1.Worksheets(1) 'ABC Matrix File 
    Set sht1 = wb2.Worksheets(1) 'Cycle Count Remainder Browse File 

    lRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row 

    Select Case ABCMatrixMonthSelect.ComboBox1.Value 
     Case "January": ABCCodeCell = 21 
     Case "February": ABCCodeCell = 23 
     Case "March": ABCCodeCell = 25 
     Case "April": ABCCodeCell = 3 
     Case "May": ABCCodeCell = 5 
     Case "June": ABCCodeCell = 7 
     Case "July": ABCCodeCell = 9 
     Case "August": ABCCodeCell = 11 
     Case "September": ABCCodeCell = 13 
     Case "October": ABCCodeCell = 15 
     Case "November": ABCCodeCell = 17 
     Case "December": ABCCodeCell = 19 
    End Select 

    'Execute Find (Vlookup) 
    Dim vDB, rngDB As Range, r As Long, c As Integer '<~~ vDB is Variant array 
    Dim rngData As Range 
    With sht 
     r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
     c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
     Set rngDB = .Range("a2", .Cells(r, c)) 
     vDB = rngDB 
    End With 
    With sht1 
     Set rngData = .Range("b1", .Range("b" & Rows.Count).End(xlUp)) 
    End With 


    'On Error Resume Next 

    For i = 1 To UBound(vDB, 1) 
    'If sht.Cells(i, 1).Value <> "" Then 
     If vDB(i, 1) <> "" Then 
      Set rng = rngData.Find(vDB(i, 1), LookIn:=xlValues, Lookat:=xlWhole) 
      If Not rng Is Nothing Then 
       'sht.Cells(i, ABCCodeCell).Value = sht1.Cells(rng.Row, 9).Value 
       vDB(i, ABCCodeCell) = rng.Offset(, 7) 
       'sht.Cells(i, 27).Value = sht1.Cells(rng.Row, 7).Value 
       vDB(i, 27) = rng.Offset(, 5) 
       'sht.Cells(i, 34).Value = sht1.Cells(rng.Row, 11).Value 
       vDB(i, 34) = rng.Offset(, 9) 
      End If 
     End If 
    Next 
    rngDB = vDB 
End Sub