VBAでVLOOKUPの速度向上について、お知恵を貸していただきたく存じます。
以下のVLOOKUPのVBAがおそく、速くしたいです。行数は２万行ぐらいです。
何卒よろしくお願い申し上げます。
Dim 範囲A As Range
Set 範囲A = Worksheets("取引先").Range("A:H")
On Error Resume Next
myCnt5 = 2
Do
Worksheets("受注データ").Cells(myCnt5, 49).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt5, 48), 範囲A, 6, False)
myCnt5 = myCnt5 + 1
If Worksheets("受注データ").Cells(myCnt5, 1).Value < 10 Then Exit Do
Loop
On Error Resume Next
myCnt6 = 2
Do
Worksheets("受注データ").Cells(myCnt6, 51).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt6, 50), 範囲A, 8, False)
myCnt6 = myCnt6 + 1
If Worksheets("受注データ").Cells(myCnt6, 1).Value < 10 Then Exit Do
Loop
On Error Resume Next
myCnt7 = 2
Do
Worksheets("受注データ").Cells(myCnt7, 53).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt7, 52), 範囲A, 6, False)
myCnt7 = myCnt7 + 1
If Worksheets("受注データ").Cells(myCnt7, 1).Value < 10 Then Exit Do
Loop
補足
上記VBAには記載していませんが、Application.ScreenUpdatingの停止、Application.Calculationを手動の設定はしています。
VBAでVLOOKUPの速度向上について、お知恵を貸していただきたく存じます。
以下のVLOOKUPのVBAがおそく、速くしたいです。行数は２万行ぐらいです。
何卒よろしくお願い申し上げます。
Dim 範囲A As Range
Set 範囲A = Worksheets("取引先").Range("A:H")
On Error Resume Next
myCnt5 = 2
Do
Worksheets("受注データ").Cells(myCnt5, 49).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt5, 48), 範囲A, 6, False)
myCnt5 = myCnt5 + 1
If Worksheets("受注データ").Cells(myCnt5, 1).Value < 10 Then Exit Do
Loop
On Error Resume Next
myCnt6 = 2
Do
Worksheets("受注データ").Cells(myCnt6, 51).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt6, 50), 範囲A, 8, False)
myCnt6 = myCnt6 + 1
If Worksheets("受注データ").Cells(myCnt6, 1).Value < 10 Then Exit Do
Loop
On Error Resume Next
myCnt7 = 2
Do
Worksheets("受注データ").Cells(myCnt7, 53).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt7, 52), 範囲A, 6, False)
myCnt7 = myCnt7 + 1
If Worksheets("受注データ").Cells(myCnt7, 1).Value < 10 Then Exit Do
Loop
補足
上記VBAには記載していませんが、Application.ScreenUpdatingの停止、Application.Calculationを手動の設定はしています。
以下のエクセルvba内で、「シート★」のＡ列（項目名：条件）にある値に該当するデータのみを、抽出するというSQLを書いているのですが、その速度を速めたいです。
時間が掛かる部分は、SELECT句のところで、Ａ列の条件を参照するのが、上から一つ一つになるためと分かっています。。。
何とか速度を速めることはできないでしょうか？お知恵を貸してください。
※Ａ列の条件が入力されている値の数（行数）は、変動します。
最小で50、最大で200となります。
◆以下、VBA（一部）－－－－－－－－－－－－－－
Dim mySQL AS String
Dim i
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 to n
mySQL = "SELECT * FROM [シート★$] WHERE 条件 = Cells(n, 1) "
※この下に、上記SQLから別シートにデータを出力するSQLを記載
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
以上
以下のエクセルvba内で、「シート★」のＡ列（項目名：条件）にある値に該当するデータのみを、抽出するというSQLを書いているのですが、その速度を速めたいです。
時間が掛かる部分は、SELECT句のところで、Ａ列の条件を参照するのが、上から一つ一つになるためと分かっています。。。
何とか速度を速めることはできないでしょうか？お知恵を貸してください。
※Ａ列の条件が入力されている値の数（行数）は、変動します。
最小で50、最大で200となります。
◆以下、VBA（一部）－－－－－－－－－－－－－－
Dim mySQL AS String
Dim i
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 to n
mySQL = "SELECT * FROM [シート★$] WHERE 条件 = Cells(n, 1) "
※この下に、上記SQLから別シートにデータを出力するSQLを記載
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
以上
以下のエクセルvba内で、「シート★」のＡ列（項目名：条件）にある値に該当するデータのみを、抽出するというSQLを書いているのですが、その速度を速めたいです。
時間が掛かる部分は、SELECT句のところで、Ａ列の条件を参照するのが、上から一つ一つになるためと分かっています。。。
何とか速度を速めることはできないでしょうか？お知恵を貸してください。
※Ａ列の条件が入力されている値の数（行数）は、変動します。
最小で50、最大で200となります。
◆以下、VBA（一部）－－－－－－－－－－－－－－
Dim mySQL AS String
Dim i
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 to n
mySQL = "SELECT * FROM [シート★$] WHERE 条件 = Cells(n, 1) "
※この下に、上記SQLから別シートにデータを出力するSQLを記載
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
以上
ユーザーフォームリストボックスに
重複なしのリストを作りたく、調べたところ以下のソースを発見しました。
記載した所思った通りに実装できたのですが
ソースがのっていたのは
詳しく解説しているサイトではなくよくわからぬままソースのコピーで実装しています
出来れば、下記の解説をお願いしたいです
Private Sub UserForm_Initialize()
Dim f As Long
Dim v As Variant
Dim Lrow As Long
Dim WS As Worksheet
Set WS = Worksheets("Sheet1")
Lrow = WS.Range("A" & CStr(Rows.Count)).End(xlUp).Row
v = WS.Range("A1:A" & CStr(Lrow)).Value
With CreateObject("Scripting.Dictionary")
For f = 1 To UBound(v)
.Item(v(f, 1)) = Empty
Next
ListBox1.List = .Keys
End With
End Sub
ユーザーフォームリストボックスに
重複なしのリストを作りたく、調べたところ以下のソースを発見しました。
記載した所思った通りに実装できたのですが
ソースがのっていたのは
詳しく解説しているサイトではなくよくわからぬままソースのコピーで実装しています
出来れば、下記の解説をお願いしたいです
Private Sub UserForm_Initialize()
Dim f As Long
Dim v As Variant
Dim Lrow As Long
Dim WS As Worksheet
Set WS = Worksheets("Sheet1")
Lrow = WS.Range("A" & CStr(Rows.Count)).End(xlUp).Row
v = WS.Range("A1:A" & CStr(Lrow)).Value
With CreateObject("Scripting.Dictionary")
For f = 1 To UBound(v)
.Item(v(f, 1)) = Empty
Next
ListBox1.List = .Keys
End With
End Sub
