こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBAについての質問です。

エクセルVBAについての質問です。
 動作環境は
 OS:WINDOWS XP
 エクセル2003  です。

今、Book1.xlsというエクセルファイルがあります。
このファイルの中に、【sheet1】,【sheet2】,【sheet3】の3つのシートが存在しています。
【sheet1】および【sheet2】には、A列=ユニーク番号、B列=データ1、C列=データ2・・・・n列=データnの値が約1500行(各行で、データの値は異なります。)入っています。
この【sheet1】と【sheet2】のデータの内容を照合して【sheet3】にその結果を反映(TRUEまたはFALSE)します。
仮に【sheet3】のあるセル(仮にD3)の値がTRUEとなったら、【sheet1】のセル(D3)の値を【sheet3】のセル(D3)に代入する。
逆に【sheet3】のあるセルの値がFALSEとなったら、そのセルはFLASEのままにする。プログラムは以下の様にしたのですが、全てを処理するまでに相当時間がかかっています。
VBAのプログラムは今回初めて書いたので、プログラムが悪いのか、プログラムの思想が悪いのかがわかりません。
どなたかご教授していただけませんか?多分、コードの書き方もキレイではないと思います(悲)

Private Sub データ照合ボタン_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim i As Long
Dim area As Range
Dim A As Variant
Dim WrkRange As String

'----シート(1)とシート(2)の各セルの値を比較----
With Sheets("sheet1")
WrkRow = .Cells(Rows.Count, 3).End(xlUp).Row
End With

Sheets("sheet3").Select
For i = 12 To WrkRow

WrkRange = Range("C" & i).Select
ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)"

WrkRange = Range("D" & i).Select
ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)"
'・
          '・
          '・
Next i

A = i - 1
Sheets("sheet1").Select
For i = 12 To A
WrkRange = Range("C" & i).Select
Selection.Copy
Range("C" & i).PasteSpecial xlPasteValues
Sheets("sheet3").Select
If Range("C" & i) = True Then
Sheets("sheet1").Select
Range("C" & i).Copy
Sheets("sheet3").Select
Range("C" & i).Select
ActiveSheet.Paste
Else:
End If
Next i

A = i - 1
Sheets("sheet1").Select
For i = 12 To A
WrkRange = Range("D" & i).Select
Selection.Copy
Range("D" & i).PasteSpecial xlPasteValues
Sheets("sheet3").Select
If Range("D" & i) = True Then
Sheets("sheet1").Select
Range("D" & i).Copy
Sheets("sheet3").Select
Range("D" & i).Select
ActiveSheet.Paste
Else:
End If
Next i
         '・
         '・
         '・   
End Sub

投稿日時 - 2008-10-11 00:36:02

QNo.4392733

困ってます

質問者が選んだベストアンサー

selectにてシート間を行ったり来たりしているので、その度に画面更新が行われます。Application.ScreenUpdating で画面更新を無効にしてみては?
また、多量のセル操作を行う場合は直接セルを参照するのではなくオブジェクト変数を参照したほうが処理が早くなるみたいです。
コードに関しては重複するところが多いので、もう少し工夫してみましょう。

でこんな感じでどうでしょか?
Sub test1()

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim i As Long
Dim j As Long
Dim MaxRow As Long
Dim MaxCol As Long

'操作するセル数が多い場合はオブジェクトを参照するほうが処理が早い
With ThisWorkbook
Set Sh1 = .Worksheets("Sheet1")
Set Sh2 = .Worksheets("Sheet2")
Set Sh3 = .Worksheets("Sheet3")
End With

'最終列、最終行を取得
MaxRow = Sh1.Range("A1").End(xlDown).row
MaxCol = Sh1.Range("A1").End(xlToRight).Column

'画面表示の更新を無効にする
Application.ScreenUpdating = False
'データを比較しTrueなら値を代入、Falseなら"FALSE"を代入
For i = 2 To MaxCol
For j = 1 To MaxRow
If Sh1.Cells(j, i) = Sh2.Cells(j, i) Then
Sh3.Cells(j, i) = Sh1.Cells(j, i)
Else
Sh3.Cells(j, i) = "FALSE"
End If
Next
Next
'画面表示の更新を有効にする
Application.ScreenUpdating = True

Set Sh1 = Nothing
Set Sh2 = Nothing
Set Sh3 = Nothing

End Sub

投稿日時 - 2008-10-11 02:07:31

お礼

yabe440 様
すいません。返事が遅れてしまい申し訳ありません。

>また、多量のセル操作を行う場合は直接セルを参照するのではなくオ ブジェクト変数を参照したほうが処理が早くなるみたいです。

オブジェクト変数を参照ですか、頭の片隅にもなかったことでした。
yabe440 様のいわれるとおり、オブジェクト変数を参照した方が、かなり早い速度(というか数秒で)で処理が完了致しました。

本当に有難う御座いました。

>コードに関しては重複するところが多いので、もう少し工夫してみましょう。

おっしゃる通りですね(笑)。自分で作ってみたものの、スマートなコードでないことは、感じていました。
これからも色々なプログラムを見て、自分なりにプログラムのアルゴリズムをスマートにまとめられる様に努力していくつもりです。

今回は有意義(自分の中にまだなかった思想)なコードを作っていただき本当に有難う御座いました!

何かありましたら、また宜しくお願い致します。

投稿日時 - 2008-10-11 22:00:21

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(2)

ANo.2

こうゆう事とは違うのでしょうか。

Sub test()
Dim i As Long, j As Long
Dim v, w, x

v = Worksheets("Sheet1").UsedRange
w = Worksheets("Sheet2").UsedRange

ReDim x(1 To UBound(v, 1), 1 To UBound(v, 2))

For i = 1 To UBound(v, 1)
x(i, 1) = v(i, 1)
For j = 2 To UBound(v, 2)
x(i, j) = IIf(v(i, j) = w(i, j), v(i, j), "FLASE")
Next
Next

Worksheets("Sheet3").Range("A1").Resize(UBound(x, 1), UBound(x, 2)).Value = x
Erase v, w, x
End Sub
的はずれでしたらごめんなさい。

投稿日時 - 2008-10-11 10:28:20

お礼

n-jun 様
返事が遅れまして申し訳ありませんでした。

>こうゆう事とは違うのでしょうか。
>的はずれでしたらごめんなさい。

いえいえ、n-jun 様のコードはやりたかった事を表現してくれています。本当に有難う御座いました。

処理の速度でいえば、体感的にですが n-jun 様のコードが一番早く感じられました。

まだまだ、未熟ですが何かありましたらこれからも宜しくお願い致します。今回は本当に有難う御座いました。

投稿日時 - 2008-10-11 22:13:18

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-