Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6563 / 76734

←次へ　｜　前へ→


	【75771】Re:大量データの比較：VLOOKUPの高速化

γ - 14/7/4(金) 22:58 -


	引用なし

	パスワード

たたき台。
Sub test()
　　Dim lastMonth As Worksheet
　　Dim thisMonth As Worksheet
　　Dim myRow1 As Long
　　Dim myRow2 As Long

　　Dim dic前月 As Object
　　Dim dic当月 As Object
　　Dim v As Variant
　　Dim vv As Variant
　　Dim k As Long
　　Dim kk As Long

　　Set dic前月 = CreateObject("Scripting.Dictionary")
　　Set dic当月 = CreateObject("Scripting.Dictionary")

　　Set lastMonth = Worksheets("前月")
　　Set thisMonth = Worksheets("今月")

　　myRow1 = lastMonth.Range("A1").CurrentRegion.Rows.Count
　　myRow2 = thisMonth.Range("A1").CurrentRegion.Rows.Count

　　'辞書の作成
　　For k = 1 To myRow2
　　　　dic前月(lastMonth.Cells(k, "L").Value) = k
　　Next

　　For k = 1 To myRow2
　　　　dic当月(thisMonth.Cells(k, "L").Value) = k
　　Next

　　' ---------削除データ
　　For k = 1 To myRow1
　　　　v = lastMonth.Cells(k, "L").Value
　　　　If Not dic当月.exists(v) Then
　　　　　　lastMonth.Cells(k, "M").Value = "削除"
　　　　End If
　　Next
　　' ---------新規データ
　　For k = 1 To myRow2
　　　　v = thisMonth.Cells(k, "L").Value
　　　　If Not dic前月.exists(v) Then
　　　　　　thisMonth.Cells(k, "M").Value = "新規"
　　　　End If
　　Next
　　' --------- 修正データ
　　For k = 1 To myRow2
　　　　v = thisMonth.Cells(k, "L").Value
　　　　If dic前月.exists(v) Then
　　　　　　kk = dic前月(v)
　　　　　　vv = lastMonth.Cells(kk, "G").Value
　　　　　　If vv <> thisMonth.Cells(k, "G").Value Then
　　　　　　　　thisMonth.Cells(k, "M").Value = "修正"
　　　　　　End If
　　　　End If
　　Next
End Sub

あとは、配列化によるスピードアップだけれど、
・新規、削除、修正箇所がさほど多くなければ、
　書き込み部分の測度上昇の余地は小さいだろう。
・読み込み部分のセル範囲を纏めて配列で読み込んでから、
　処理する方法もあるけれど、劇的に早くなる気は余りしない。
そこそこのスピードは出るのではないか。

6 hits

▼

【75769】大量データの比較：VLOOKUPの高速化 西瓜糖 14/7/4(金) 14:14