2017-08-01 13 views
0

私は一連のフォームといくつかのマクロからなる大きなプロジェクトに取り組んでいます。私が毎月更新する必要がある主な報告書は、21K行で成長しています。 12カ月間の更新をすべて12個の別々の列で収集します。 「更新」を完了するには、列「A」に含まれるメインファイルの部品番号(21k行はすべて部品番号とその情報)を一致させ、部品番号で生成された別のレポートに一致させる必要がありますカラム「B」)とが一致した場合(正確に一致する必要がある)、以下を返す:大きな20k行シートのVlookupの代わりに検索しますか?

可変

プレイスによってカラム7 SHT1の値を指定SHT列にプレース列9 SHT1の値をROによるSHT列の列11の値がSHT 1 34

が一致するたびにSHT列27

置き、サイクリング行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これはそれです。私は前に投稿したように書き直さなければならなかったが、誰も応答しなかったので、数日後に削除した。ありがとうございました! - Athena、別名SharePoint0508 – SharePoint0508

+3

それは私によく見えます...それは現時点では遅すぎますか?あなたは 'Application.ScreenUpdating = False、Application.Cursor = xlWait'などを使用していますか?特に動作しないものはありますか?これはCode Reviewにとってより良い質問かもしれません。 – dwirony

+0

*私はちょうど別のコードブロックで実現しましたが、この同じ方法は完全一致を実行していませんでした。*、これはどういう意味ですか? – dwirony

答えて

1

それは上のトピックスタックオーバーフローのために実際にはないように私は、など、あなたのコードは、速度のための最高の可能なコードであるかどうかについてはコメントしません - 質問のこれらの並べ替えはCode Reviewに求めるべきです。

しかし私は、コメントあなた「(完全一致する必要があります)」再お答えします:

Excelが検索を実行する際に様々なオプションを指定することをユーザーに許可する:

enter image description here

すべての(ほとんどの? )が記憶され、次の検索でデフォルトで使用されます。ユーザーが手動検索を実行するか、VBAコード内のFindにプログラムされています。

あなたの現在の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()を使用する場合と比較して非常に遅いです。例えば、20,000の異なる値の列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 

出力:SHT式セルをしていない場合

Find   19.75781  found 2000 
Match   1.46875  found 2000 
+0

検索範囲を最初に配列に読み込むと 'Match'がさらに速くなりますか? – YowE3K

+0

Hmmm - 表示されません - Findに対しては14.32、Matchには1.11、配列に対してはMatchに対しては13.06(配列に読み込まれる時間は '0'として表示されます) – YowE3K

+0

@ YowE3K - Matchはより速く(約10倍)配列よりもワークシートに対して(編集済み:あなたはすでに計算しています) –

0

は、変異体配列を使用して高速です。

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 
関連する問題