Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


68926 / 76734 ←次へ | 前へ→

【12331】検索して抽出の高速化を・・・
質問  kawata  - 04/3/31(水) 8:44 -

引用なし
パスワード
   kawataです、お世話になっております。
よろしくお願いします。
(Windows2000/Excel2000)

DBより抜き出したデータが下記のようなレイアウトであるとして、

   A   B   C   D   E   F   G   H
1 コード 名称  台数 金額     コード 台数 金額
2  a01 あああ            a01   1  500
3  a04 いいい            a02   1  500
4  a05 ううう            a03   1  500
5  a09 えええ            a04   1  500

・同一シート上です
・A列のコードは約6000件昇順重複なし
・F列のコードは約25000件昇順重複なし
 (実際のコードは12桁です)

で、A列のコードの件数・金額をF列で検索してG列H列のデータを
それぞれC列D列に書き込みたいのですが・・・。
あれこれ思案して、以下のようなコードを書いてみました。

Sub data_picup()
Dim d2sheet As Worksheet
Dim myRange1 As Range, myRange2 As Range
Dim c_data, d_data
Dim start
  start = Timer
  Set d2sheet = Sheets("data2")
  With d2sheet
    Set myRange1 = .Range("a2:d" & .Range("a65536").End(xlUp).Row)
    Set myRange2 = .Range("f2:h" & .Range("f65536").End(xlUp).Row)
    .Columns("c:d").Clear
    d_data = myRange1.Value
    c_data = myRange2.Value
    x = 1
    For i = 1 To UBound(d_data)
      chk = d_data(i, 1)
      For j = x To UBound(c_data)
        If c_data(j, 1) = chk Then
          d_data(i, 3) = c_data(j, 2)
          d_data(i, 4) = c_data(j, 3)
          x = j
          Exit For
        End If
      Next
    Next
    myRange1.Value = d_data
  End With
  Set myRange1 = Nothing
  Set myRange2 = Nothing
  Set d2sheet = Nothing
  Debug.Print Timer - start

End Sub

これで、だいたい上の件数で19秒ほどかかります。(件数は今後増えていきます)
もう少し早くならないものかと思いました。
修正すべき点、ご指摘ください、よろしくお願いします。
1 hits

【12331】検索して抽出の高速化を・・・ kawata 04/3/31(水) 8:44 質問
【12340】Re:検索して抽出の高速化を・・・ ichinose 04/3/31(水) 12:14 発言
【12344】Re:検索して抽出の高速化を・・・ kawata 04/3/31(水) 13:09 お礼
【12350】Re:検索して抽出の高速化を・・・ kawata 04/3/31(水) 15:34 お礼

68926 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free