質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

3回答

3986閲覧

VBA高速化

退会済みユーザー

退会済みユーザー

総合スコア0

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

2グッド

0クリップ

投稿2017/01/08 08:24

お世話になっております。

ここで質問し、皆様のご協力の下、なんとか差分抽出マクロを完成させましたが、
実行してみると、すごく遅いです。処理が終わるまで、133秒程度かかり、マクロ実行中は、Excelがフリーズしたような状態になります。。。。データー量としては、3,000行程度です。
(これだと普通にExcelの関数を使った方が早い状態です)

そこで、処理を高速化するために、コードをどのように修正していけば良いでしょうか?

このマクロを作ることにより、結構、ループや条件分岐や変数の概念が分かるようになり、かなり勉強になりました。

ただ、もっと、高速化を図りたいですね。。。

↓今回作成し、実行したコード↓

vba

1'作業前データーは、A~F列に貼り付ける。 2'作業後データーは、I~N列に貼り付ける。 3 4Sub MyDiff() 5 Dim cRow As Long 6 Dim befor_Area As Range '作業前対象範囲 7 Dim befor_Rng As Variant '作業後対象範囲内のセルを格納する変数 8 Dim kRow As Long 9 Dim after_Area As Range '作業後対象範囲 10 Dim after_Rng As Variant '作業後対象範囲内のセルを格納する変数 11 Dim c As Long 'C列用カウンター変数 12 Dim k As Long 'K列用カウンター変数 13 Dim h As Long 'H列用カウンター変数 14 Dim diff As Long 15 Dim hRow As Long 16 17 cRow = Cells(Rows.Count, "C").End(xlUp).Row 'C列の最終行取得 18 kRow = Cells(Rows.Count, "K").End(xlUp).Row 'K列の最終行取得 19 20 '作業前のMACアドレスで昇順にソート 21 Range(Cells(2, 1), Cells(cRow, 6)).Sort _ 22 key1:=Range("C2"), _ 23 Order1:=xlAscending, _ 24 Header:=xlYes 25 26 '作業後のMACアドレスで昇順にソート 27 Range(Cells(2, 9), Cells(kRow, 13)).Sort _ 28 key1:=Range("K2"), _ 29 Order1:=xlAscending, _ 30 Header:=xlYes 31 32 '作業前データーの空白チェック。 33 '空白があった場合は、空白に-を入れる。 34 35 36 Set befor_Area = Range(Cells(3, "A"), Cells(cRow, "F")) 37 38 For Each befor_Rng In befor_Area 39 If befor_Rng.Value <> "" Then 40 '何もしない 41 Else 42 befor_Rng.Value = "-" 43 End If 44 Next 45 46 '作業後データーの空白チェック。 47 '空白があった場合は、空白に-を入れる。 48 49 Set after_Area = Range(Cells(3, "I"), Cells(kRow, "N")) 50 51 For Each after_Rng In after_Area 52 If after_Rng.Value <> "" Then 53 '何もしない 54 Else 55 after_Rng.Value = "-" 56 End If 57 Next 58 59 60 'C列を元に、K列のMACアドレスのチェックを行う。 61 '差分があった場合、G列に×を入れる。 62 Cells(2, "G").Value = "差分1" 63 c = 3 64 65 Do While Cells(c, "C").Value <> "" 66 k = 3 67 Cells(c, "G").Value = "×" 68 Do While Cells(k, "K").Value <> "" 69 If Cells(c, "C").Value = Cells(k, "K").Value Then 70 Cells(c, "G").Value = "" 71 Exit Do 72 End If 73 k = k + 1 74 Loop 75 c = c + 1 76 Loop 77 78 'K列を元に、C列のMACアドレスのチェックを行う。 79 '差分があった場合、H列に×を入れる。 80 Cells(2, "H").Value = "差分2" 81 82 k = 3 83 Do While Cells(k, "K").Value <> "" 84 c = 3 85 Cells(k, "H").Value = "×" 86 Do While Cells(c, "C").Value <> "" 87 If Cells(k, "K").Value = Cells(c, "C").Value Then 88 Cells(k, "H").Value = "" 89 Exit Do 90 End If 91 c = c + 1 92 Loop 93 k = k + 1 94 Loop 95 96 97 'H列に"×"がるものデーター(H列~N列)をP列~V列へ移動させる。 98 kRow = Cells(Rows.Count, "K").End(xlUp).Row 99 hRow = kRow 100 diff = 3 101 102 For h = 3 To hRow 103 104 If Cells(h, "H").Value <> "" Then 105 Range(Cells(h, "H"), Cells(h, "N")).Cut Destination:=Range(Cells(diff, "P"), Cells(diff, "V")) 106 diff = diff + 1 107 End If 108 Next h 109 110End Sub

ご教授下さい。

hihijiji, Wolf👍を押しています

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答3

0

ついに完成されたのですね!お疲れ様です。

さて、ステップインでpipiさんが作成したコードを実行したところ、
MACアドレスの差分チェックに時間が掛かってしまっているようです。

対策としては、K列にC列と異なる値があるか1行1行チェックするのではなく、
FindメソッドでまとめてC列をチェックすれば、かなりの高速化が図れるのではないかと思います。

VBA

1Dim result As Range '差分チェックの結果 2k = 3 3 4Do While Cells(k, "K").Value <> "" 5 '差分チェック 6 Set result = Range(Cells(3, "C"), Cells(cRow, "C")).Find(What:=Cells(k, "K").Value) 7 '差分があった場合、H列に×を入れる 8 If Not result Is Nothing Then 9 Cells(k, "H").Value = "×" 10 End If 11 'ループカウンタ加算 12 k = k + 1 13Loop

また、_katoさんのアドバイスにある無駄な表示を止めるというのも効果的な方法です。
データ移動処理の高速化に貢献してくれるはずです。
(Excelの設定を変更するメソッドなので、Trueにするのを忘れないこと)

VBA

1Application.ScreenUpdating = False '画面描写を停止 2Application.ScreenUpdating = True '画面描写を再開

投稿2017/01/08 12:09

N-u-u

総合スコア113

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2017/01/09 09:11

アドバイス有難うございます。オブジェクト変数を学習し、もっと高速に処理できるように書き換えてみます。
guest

0

まずは以下のページの、1.無駄な表示を止めるをやってみてはどうでしょうか?
簡単だけど効果は大きいです。
VBA高速化テクニック

それでも遅い場合は、無駄な処理やロジックをひとつづつ見直していく必要があります。
その場合も、上記のサイトの、2.からの項目が大変参考になります。

投稿2017/01/08 09:16

_kato

総合スコア149

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

ベストアンサー

抜本的な解決になるかわかりませんが・・。
G列とH列に一度「X」を入れて値が同じなら空白に書き直しているのが
気になりました。

最初にG列とH列をすべて空白を書き込んだうえで、値が同じでないものについて
「X」を入れるようにしたほうが良いと思います。

最初にG列とH列を空白にしておく
→VBA実行前に何か文字が入っていてもG列とH列は空白になる
Columns("G").Clear
Columns("H").Clear

do whileの2行後のXを入れている行を消去
Cells(c, "G").Value = "×"
Cells(c, "H").Value = "×"

イコールの時に空白にするのではなく、異なるときに「X」を入れるようにする
(変更前)
If Cells(c, "C").Value = Cells(k, "K").Value Then
Cells(c, "G").Value = ""
Exit Do

(変更後)
If Cells(c, "C").Value <> Cells(k, "K").Value Then
Cells(c, "G").Value = "×"
Exit Do

※H列も同じようにやってください。

あとは、プログラムのどの部分で処理に時間がかかっているかを確認するために
ステップインを使うのが良いです。
EXCEL VBAであれば、CTRL + F8を実施して途中まで実行させることができます。
http://hp.vector.co.jp/authors/VA016119/step/step01.html

投稿2017/01/08 11:04

hirataira

総合スコア29

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2017/01/09 09:11

アドバイス有難うございます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問