| 
    
     |  | 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秒ほどかかります。(件数は今後増えていきます)
 もう少し早くならないものかと思いました。
 修正すべき点、ご指摘ください、よろしくお願いします。
 
 |  |