|
こんにちは。かみちゃん です。
>今現在、sheets(1)の1行取得しsheets(2)の1行も取得
>比較し「E列」が値が異なる場合のみ
>sheets(3)にコピーする様にしたいのですが
>今現在のコードだと30分以上かかってしまいあまりにも効率が悪い為
>同じ条件で処理時間の短縮を図るにはどのようにしたらいいでしょうか?
Sheet1およびSheet2が同じ行数であること、
A列〜D列の内容の確認は行なわないこと
である前提ですと、以下のコードでいかがでしょうか?
提示されたデータによる動作確認はしましたが、1500行の負荷試験はしていませ
んので、結果うまくいけば、どれくらい短縮になったか教えてください。
Sub Macro1()
Dim vntData1 As Variant
Dim vntData2 As Variant
Dim lngMaxRow As Long
Dim lngRow As Long
Dim lngResultRow As Long
vntData1 = Sheets("Sheet1").Range("A1").CurrentRegion.Value
vntData2 = Sheets("Sheet2").Range("A1").CurrentRegion.Value
lngMaxRow = UBound(vntData1, 1)
For lngRow = 1 To lngMaxRow
If vntData1(lngRow, 5) <> vntData2(lngRow, 5) Then
lngResultRow = lngResultRow + 1
Sheets("Sheet3").Cells(lngResultRow, 1).Resize(, 5).Value = _
Array(vntData2(lngRow, 1), vntData2(lngRow, 2), vntData2(lngRow, 3), vntData2(lngRow, 4), vntData2(lngRow, 5))
End If
Next
MsgBox "Fin!!"
End Sub
|
|