| |
今現在、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
よろしくお願いします。
|
|
凪
- 06/9/4(月) 16:26 -
