2017-07-13 13 views
0

私の作品次のコードを、持っているが、少し遅いですを使用してVLOOKUPエクセル、私は同じですが、使用して配列をしたいと思っ遅さのVBAは、配列

Sub AddValues() 
Dim Srng As Range 
Dim search_value As Variant 

    PG = "Data" 
    Ln = 2 

    Set Srng = Worksheets("Coniguration").Range("_Configuration") 
    LastRow = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count 

    For Ln = 2 To LastRow 
    search_value = Val(ActiveWorkbook.Sheets(PG).Cells(Ln, "A").Value) 
     ActiveWorkbook.Sheets("Data").Cells(Ln, "CA").Value = Application.VLookup(search_value, Srng, 3, False) 
     ActiveWorkbook.Sheets("Data").Cells(Ln, "CB").Value = Application.VLookup(search_value, Srng, 4, False) 
     ActiveWorkbook.Sheets("Data").Cells(Ln, "CC").Value = Application.VLookup(search_value, Srng, 5, False) 
     ActiveWorkbook.Sheets("Data").Cells(Ln, "CD").Value = Application.VLookup(search_value, Srng, 6, False) 
     ActiveWorkbook.Sheets("Data").Cells(Ln, "CF").Value = Application.VLookup(search_value, Srng, 7, False) 

    Next Ln 
End Sub 

答えて

3

一つ確かソースは、あなたがやっているということです各繰り返しで同じ検索を5回繰り返します。代わりに、一致する行を1回だけ見つけて、一致した行からセルをコピーすることができます。面白いのは、シートの参照を一度取得し、すべての繰り返しでWorksheets(name)のワークシートを取得しないようにすることです。

Sub AddValues() 
    Dim Srng As Range, Ln As Long, matchRow, search_value 
    Set Srng = Worksheets("Configuration").Range("_Configuration") 

    With Worksheets("Data") 
    For Ln = 2 To .Cells(.Rows.count, "A").End(xlUp).row 
     search_value = val(.Cells(Ln, "A").Value2) 

     ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 
     ' Find matching row only once and copy the results 
     matchRow = Application.match(search_value, Srng.Columns(1), 0) 
     If IsError(matchRow) Then 
     Debug.Print search_value & " : Not found" 
     Else 
     .Cells(Ln, "CA").Resize(, 4).value = Srng.Cells(matchRow, 3).Resize(, 4).Value2 
     .Cells(Ln, "CF").value = Srng.Cells(matchRow, 7).Value2 
     End If 
    Next Ln 
    End With 
End Sub 
+0

今、あなたは "私"の試合に参加しています;) –

0

ここでループを回避する方法があります。まず、ターゲットセルに数式を入力し、数式を値に変換します。

Sub AddValues() 

    Dim Srng As Range 
    Dim LastRow As Long 

    Set Srng = Worksheets("Coniguration").Range("_Configuration") 

    With Worksheets("Data") 
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
     With .Range("CA2:CA" & LastRow) 
      .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 3, 0)" 
      .Value = .Value 
     End With 
     With .Range("CB2:CB" & LastRow) 
      .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 4, 0)" 
      .Value = .Value 
     End With 
     With .Range("CC2:CC" & LastRow) 
      .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 5, 0)" 
      .Value = .Value 
     End With 
     With .Range("CD2:CD" & LastRow) 
      .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 6, 0)" 
      .Value = .Value 
     End With 
     With .Range("CF2:CF" & LastRow) 
      .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 7, 0)" 
      .Value = .Value 
     End With 
    End With 

End Sub 
0

非常にA.S.HとDomenicに感謝します。どちらの方法も私のコードよりも優れています。

最後に、Domenicから提供されたものを使用します。これは最速のものです。