Excel VBA質問箱 IV

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

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


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

39620 / 76738

←次へ　｜　前へ→


	【42228】処理時間の短縮

凪 - 06/9/4(月) 16:26 -


	引用なし

	パスワード

今現在、sheets(1)の1行取得しsheets(2)の1行も取得
比較し「E列」が値が異なる場合のみ
sheets(3)にコピーする様にしたいのですが
今現在のコードだと30分以上かかってしまいあまりにも効率が悪い為
同じ条件で処理時間の短縮を図るにはどのようにしたらいいでしょうか？

※本試験では各シート約1500行あります。

例
sheets(1)
　A　　 B　　 C　　 D　　 E
1 A1　　B1　　C1　　D1　　E1
2 A1　　B1　　C1　　D2　　E2
3 A1　　B1　　C1　　D3　　E3
4 A1　　B1　　C1　　D4　　E4
5 A1　　B1　　C1　　D5　　E5

sheets(2)
　A　　 B　　 C　　 D　　 E
1 A1　　B1　　C1　　D1　　xx
2 A1　　B1　　C1　　D2　　E2
3 A1　　B1　　C1　　D3　　yy
4 A1　　B1　　C1　　D4　　E4
5 A1　　B1　　C1　　D5　　zz

sheets(3)
　A　　 B　　 C　　 D　　 E
1 A1　　B1　　C1　　D1　　xx
2 A1　　B1　　C1　　D3　　yy
3 A1　　B1　　C1　　D5　　zz

コード
s3x = 0
With Sheets(1)
For X = 1 To .UsedRange.Rows.Count
　　s1prm(0) = .Cells(X, 1)
　　s1prm(1) = .Cells(X, 2)
　　s1prm(2) = .Cells(X, 3)
　　s1prm(3) = .Cells(X, 4)
　　s1prm(4) = .Cells(X, 5)
　　
　　With Sheets(2)
　　For Y = 1 To .UsedRange.Rows.Count
　　　　s2prm(0) = .Cells(Y, 1)
　　　　s2prm(1) = .Cells(Y, 2)
　　　　s2prm(2) = .Cells(Y, 3)
　　　　s2prm(3) = .Cells(Y, 4)
　　　　s2prm(4) = .Cells(Y, 5)
　　　　If s1prm(0) <> s2prm(0) Then
　　　　ElseIf s1prm(1) <> s2prm(1) Then
　　　　ElseIf s1prm(2) <> s2prm(2) Then
　　　　ElseIf s1prm(3) = s2prm(3) Then
　　　　　　If s1prm(4) = s2prm(4) Then
　　　　　　　　Exit For
　　　　　　ElseIf s1prm(4) <> s2prm(4) Then
　　　　　　　　Diff_V = True
　　　　　　　　Exit For
　　　　　　End If
　　　　End If
　　Next
　　End With
　　　　　　
　　With Sheets(3)
　　If Diff_V = True Then
　　　　.Cells(s3x, 1) = s2prm(0)
　　　　.Cells(s3x, 2) = s2prm(1)
　　　　.Cells(s3x, 3) = s2prm(2)
　　　　.Cells(s3x, 4) = s2prm(3)
　　　　.Cells(s3x, 5) = s2prm(4)
　　　　s3x = s3x + 1　　　　　　
　　　　Diff_V = False
　　End If
　　End With
Next
End With

よろしくお願いします。

0 hits

▼

【42228】処理時間の短縮 凪 06/9/4(月) 16:26

≪