Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8.1 Pro : Excel 2007)
2つのブックの値の比較
投稿日時: 20/02/05 19:25:47
投稿者: FILETUBE

こんばんは。
1つ教えて下さい。
 
 
2つのブック(A.xlsxとB.xlsx)があります。
オープンしwksとwks2としてあります。
 
A.xlsxとB.xlsxの3列を比較して等しければ
AにBの値をセットします。
 
For cnt = 2 TO maxrow
 
  IF wks.cells(cnt,1) <> "" Then
   
     For cnt2 = 2 TO maxrow2
    
         IF wks.cells(cnt,1) = wks2.cells(cnt2,5) And
            wks.cells(cnt,2) = wks2.cells(cnt2,6) And
            wks.cells(cnt,3) = wks2.cells(cnt2,7) Then
            wks.cells(cnt,10) = wks2.cells(cnt2,20)
            Exit For
         End If
     Next
  End If
Next
 
のようにコーディングしましたがA,B両方5000件位あるので
かなり時間がかかります。
 
もっと良い方法はありますか。
分かる方おられましたら教えて頂けないでしょうか。
 
宜しくお願いします。

回答
投稿日時: 20/02/05 19:34:47
投稿者: takesi

 
http://officetanaka.net/excel/vba/speed/s11.htm
配列を使う
 
http://officetanaka.net/excel/vba/speed/s13.htm
値貼り付けは遅い
 
このようなページあります。

回答
投稿日時: 20/02/05 19:50:51
投稿者: takesi

マクロVBAの高速化・速度対策の具体的手順と検証
https://excel-ubara.com/excelvba4/EXCEL228.html
 
すごいですね、究極
Application.ScreenUpdating 、Application.Calculation
の切り替え時間すら邪魔なそうです。
 

回答
投稿日時: 20/02/05 20:24:11
投稿者: simple

配列やDictionaryを使うと早くなるでしょうね。
このあいだも、同じような話がありました。
https://www.moug.net/faq/viewtopic.php?t=79023
なんかが参考になるかも知れません。
 
ところで、確認です。
Bブックのデータですけど、
5列、6列、7列の組でみたとき、
ふっつ(以上の)行に、同じ組み合わせのデータが重複することはありますか?
もしあった場合、どの行の20列データを転記しますか?

投稿日時: 20/02/05 21:14:58
投稿者: FILETUBE

回答ありがとうございます。
なるほど、配列(Range)かDictionaryですね。
 
Bブックに5、6、7列に重複データはありません。
 
3列の比較になるとFindは使えないですね?
 
If文で比較するしかないでしょうか?
 

回答
投稿日時: 20/02/05 22:35:23
投稿者: simple

回答拝見。
>なるほど、配列(Range)かDictionaryですね。
配列とRangeは違いますよ。
また、配列かDictionary の二者択一ではなく、両方を使います。
参考スレッドをチラ見するとよいのでは?
  
Dictionaryについては、
複数セルの値をTab文字か何かを間にはさんだ連結文字列を作り、
それを Keyにし、
行頭行番号を Itemとするものを作成して使うとよいでしょうね。
 
Findの利用、ちょっと趣旨がよくわかりません。
ところで、5000行で、どのくらいの時間がかかるんですか?

投稿日時: 20/02/05 22:49:44
投稿者: FILETUBE

回答ありがとうございます。
両方5000件で20分くらいかかります。
 
Findは検索文字列が1つかと思い
質問しました。
 
配列は早速試してみたいと思います。

回答
投稿日時: 20/02/06 17:47:38
投稿者: simple

質問者さんがトライされている間、関連する話をしてみます。
 
(1) AND評価の非効率性

If wks.cells(cnt,1) = wks2.cells(cnt2,5) And  _
   wks.cells(cnt,2) = wks2.cells(cnt2,6) And  _
   wks.cells(cnt,3) = wks2.cells(cnt2,7) Then
という式は、
 
If wks.cells(cnt,1) = wks2.cells(cnt2,5) Then
   If wks.cells(cnt,2) = wks2.cells(cnt2,6) Then  
      If wks.cells(cnt,3) = wks2.cells(cnt2,7) Then
と書いても同じ効果が得られ、後者のほうが速度的には早くなります。
1/3くらいに短縮されます。
 
というのは、
前者(And方式)では、最初の条件がFalseでも、残りの評価が行われるので、
それが無駄になるわけです。
後者は、そうした無駄がありません。
 
言語によっては、AND論理演算子の評価にあたって、
最初の条件がFalseなら、残りは評価せずに、飛ばす仕様のものもあります。
こうした評価は、短絡評価(最小評価)と呼ばれ、多くの言語でこれが採用されています。
この場合は、余り無駄が生じません。
 
しかし、VBA(VB6)のANDは非短絡評価であり、すべての条件がもれなく評価されて
しまう方式が採用されています。言語仕様としては、やや珍しい部類に入るかもしれません。
https://ja.wikipedia.org/wiki/%E7%9F%AD%E7%B5%A1%E8%A9%95%E4%BE%A1 参照
 
上記の特徴を考えると、
今回のような速度を求める場合は、3つのIfを重ねたほうが有利になります。
 
勿論、速度が求められない場合は、意図が分かり易いこともあって、ANDが使われることが
あります。場面によって、使い分けたほうがよいと思います。
 
(2)
作業領域として、3つの列を連結したものを作っておけば、VLOOKUPなりMatchなりで、
事は済みます。
このとき、通常は使われない文字を間に挟むことが行われます。
これは、"abc" ,"de" と "ab","cde"を同一のものと誤認してしまわないための仕掛けです。
 
ワークシート関数は高速ですから、5000件でも、照合、表引きに要する時間は
1秒かかりません。

回答
投稿日時: 20/02/06 22:35:08
投稿者: simple

参考にしてください。
前のコードを殆ど同じです。たぶん、瞬時に終わると思われます。
 

Option Explicit

Sub test()
    Dim dic     As Object
    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim lstRow1 As Long
    Dim lstRow2 As Long
    Dim mat1    As Variant
    Dim mat2    As Variant
    Dim v       As Variant
    Dim k       As Long
    Dim s       As String
    
    Dim t
    t = Timer

    Set ws1 = Workbooks("A.xlsx").Worksheets(1)  '■適切に修正してください。
    Set ws2 = Workbooks("B.xlsx").Worksheets(1)  '■適切に修正してください。
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    lstRow1 = ws1.Cells(Rows.count, "A").End(xlUp).Row
    lstRow2 = ws2.Cells(Rows.count, "E").End(xlUp).Row

    mat1 = ws1.Cells(1, 10).Resize(lstRow1, 1).Value
    mat2 = ws2.Cells(1, 20).Resize(lstRow2, 1).Value
    
    '【ws2の5〜7列の連結データ → その行番号】の対応関係をdictionaryに保持
    v = ws2.Range("E1").Resize(lstRow2, 3).Value
    For k = 2 To lstRow2
        s = v(k, 1) & vbTab & v(k, 2) & vbTab & v(k, 3)
        dic(s) = k
    Next

    '比較判定
    v = ws1.Range("A1").Resize(lstRow1, 3).Value
    For k = 2 To lstRow1
        s = v(k, 1) & vbTab & v(k, 2) & vbTab & v(k, 3)
        If dic.Exists(s) Then
            mat1(k, 1) = mat2(dic(s), 1)
        End If
    Next
    
    'シートに書き込み
    ws1.Cells(1, 10).Resize(lstRow1, 1) = mat1

    Debug.Print Timer - t    'かかった秒数を表示
End Sub

回答
投稿日時: 20/02/09 22:19:54
投稿者: simple

突発事象が発生したのであればともかく、
コメントがあってから、3日も何のコメントもなく放置するのはいかがなものですか?
ちょっと失礼ではないかと思う。簡単な反応くらいすべきでは?

投稿日時: 20/03/03 08:04:07
投稿者: FILETUBE

 simpleさん、大変申し訳ありません。
別の質問と勘違いしまして、閉じたものと勘違いしていました。
本当に申し訳ありませんでした。
 
すごい回答ありがとうございます。

投稿日時: 20/03/04 11:50:21
投稿者: FILETUBE

お世話になっています。
 
AA.xlsxはG(7),H(8),K(9)列で,BB.xlsxはC(3),H(8),I(9)列で比較し
BB.xlsxのO(15)列の値をAA.xlsxのZ(26)列にセットしたく
下記のように訂正しました。
 
 
    Dim dic As Object
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lstRow1 As Long
    Dim lstRow2 As Long
    Dim mat1 As Variant
    Dim mat2 As Variant
    Dim v As Variant
    Dim k As Long
    Dim s As String
   
    Dim wb As Workbook
    Set wb = Workbooks.Open("C:\test\AA.xlsx")
    Set ws1 = wb.Worksheets(1)
     
    Dim wb2 As Workbook
    Set wb2 = Workbooks.Open("C:\test\BB.xlsx")
    Set ws2 = wb2.Worksheets(1)
   
    Set dic = CreateObject("Scripting.Dictionary")
     
    lstRow1 = ws1.Cells(Rows.Count, "G").End(xlUp).Row
    lstRow2 = ws2.Cells(Rows.Count, "C").End(xlUp).Row
 
    mat1 = ws1.Cells(1, 26).Resize(lstRow1, 1).Value
    mat2 = ws2.Cells(1, 15).Resize(lstRow2, 1).Value
     
    '【ws2の3〜9列の連結データ → その行番号】の対応関係をdictionaryに保持
    v = ws2.Range("C1").Resize(lstRow2, 7).Value
    For k = 2 To lstRow2
        s = v(k, 1) & vbTab & v(k, 6) & vbTab & v(k, 7)
        dic(s) = k
    Next
 
    '比較判定
    v = ws1.Range("G1").Resize(lstRow1, 6).Value
    For k = 2 To lstRow1
        s = v(k, 1) & vbTab & v(k, 2) & vbTab & v(k, 5)
        If dic.Exists(s) Then
            mat1(k, 1) = mat2(dic(s), 1)
        End If
    Next
     
    'シートに書き込み
    ws1.Cells(1, 26).Resize(lstRow1, 1) = mat1
 
これに
AA(27)列にAA.xlsxのG列とBB.xlsxのC列が等しかった時Yをセット
AB(28)列にAA.xlsxのG列,H列とBB.xlsxのC列,H列が等しかった時Yをセット
AC(29)列にAA.xlsxのG列,H列,K列とBB.xlsxのC列,H列,I列が等しかった時Yをセット
の処理を付け加えたいのです。
 
大変申し訳ありません、わかる方おられましたら
教えて頂けないでしょうか。
 
宜しくお願いします。

回答
投稿日時: 20/03/05 10:21:36
投稿者: mattuwan44

あの。。。。
 
操作対象は、
データが変化したかを評価した結果を保存するブックと
変化したデータのあるブック
で、その他、マクロを書きこんであるブックならば、
 
それぞれの使用されているセル範囲(使用している列)はどのようになってますか?
あと、それぞれのブックはシート1つづつですか?
 
たとえば、
 
cells(cnt2,5)
 
と書いたときにその返ってくるセル範囲(Rangeオブジェクト)は、
「どのブックのどのシートのセル範囲」という情報を含んでいる(明示を省略したら勝手に補完される)ので、
まずは、操作対象を明確にするところからコードを考えてみないですか?
 
やりたいことを勉強するのはモチベーションの維持には効果あるでしょうが、
FILETUBEさんは、
やりたいことのサンプルを書いてもらって、出来たと思っていても応用する力がなさそうです。
ちょいちょいテクニックをつまみ食いするだけでは、なかなかマクロを作れるようになるのは、
難しいかなと思いました。
長く勉強しててもなかなかいいマクロを作るのは難しいですが、
基礎的なところも並行して覚えていく時期ではないかと思いました。
 
s = v(k, 1) & vbTab & v(k, 6) & vbTab & v(k, 7)
 
↑このコードが書けるなら、
 
AB(28)列にAA.xlsxのG列,H列とBB.xlsxのC列,H列が等しかった時Yをセット
 
ここも同じようにすればいいのでは?
 
けど、その前に、付帯の作業はメインのプロシージャから追い出すことを覚えるといいかもです。
具体的にはとある作業、
例えばどこかのセルの値とどこかのセルの値が同じかどうかの評価
今でてきているコードだと(詳しく見てないですが)、
 
If dic.Exists(s) Then
 
ですね。
こういうのをもっと汎用的に自分の使いやすいように関数を自作していったりできるといいと思いました。
 
そうすると、
 

sub メイン()
  操作対象の取得
  新しいデータを行毎に順次見て行く
    ・新しいデータのうちの行の5、6、7番目のセルの値が同じデータを探し、
     古いデータの行の10番目の値を新しいデータの20番目の値に書き換える
    ・AA(27)列にAA.xlsxのG列とBB.xlsxのC列が等しかった時Yをセット
    ・AB(28)列にAA.xlsxのG列,H列とBB.xlsxのC列,H列が等しかった時Yをセット
    ・AC(29)列にAA.xlsxのG列,H列,K列とBB.xlsxのC列,H列,I列が等しかった時Yをセット
  次へ
    操作対象の解放
end sub

 
と書けるようになると思います。
各作業の詳細は別のプロシージャで、
各作業毎に考えます。
 
あれ?
比較対象のAとB?
古いデータと新しいデータ?
同じ行かどうかは関係なくデータのどこかにあればいいのかな?で、
探して存在すれば、見つかった行を書き換える感じですかね?
逆にどこにあるかをどうやって見つけるかってことですか?
っていうことは、その条件分、辞書を作ればいいというのはお分かりになりますでしょうか?
 
Set dic = CreateObject("Scripting.Dictionary")
 
あと、
AとBってよく質問のとき、説明で出てきますが、
少し役割が分かる表現にしていただけるとわかりやすいです。
変数名も同じです、役割を想像しやすい名前を付けると、
コードが読みやすいです。
 
> IF wks.cells(cnt,1) = wks2.cells(cnt2,5)
IF wshOld.cells(cnt,1) = wshNew.cells(cnt2,5)
 
 

投稿日時: 20/03/05 13:14:40
投稿者: FILETUBE

大変丁寧な回答ありがとうございます。
 
全く別のブックからAA.xlsx,BB.xlsxを比較する処理になります。
それぞれシートは1つです。
 
BB.xlsxは単価マスタで比較しイコールの単価をAA.xlsxにセットします。
 
3つの項目で比較するのですが、1つでもイコールとなった場合
27列目にYを、2つイコールとなったら28列目にYをセットします。
 
Set dic = CreateObject("Scripting.Dictionary")を
あと2つ作るという事になるのでしょうか。
 
応用が利かず大変申し訳ありません。

回答
投稿日時: 20/03/05 15:54:27
投稿者: mattuwan44

>応用が利かず大変申し訳ありません。
 
そのように見えるといったまでで、批判しているわけではありません。
自覚していただいて頑張って勉強していただけたら、と思い言及しました。
なので謝る必要はありませんし、卑屈になる必要もありません。
 
こちらは、個人的にdictionaryオブジェクトを使うことは避けているので、
解説は上手くできないですが、
 
If dic.Exists(s) Then
↑ここで自作した辞書の中にキーワードが存在するか確認し、もしあれば、
mat1(k, 1) = mat2(dic(s), 1)
キーワードを索引し、値を転記しているかと思います。
これはシート上に一覧を作り、CoutIf関数で数えて存在確認し、Vlookup関数で索引しているのと、
表面上のやっていることはほぼほぼ同じなので、無理にdictionaryオブジェクト使わなくても、
出来なくはないなという印象です。
ただし、dictionaryオブジェクトを使えば、この作業を全てメモリー上だけで行えるので、
処理速度は格段に速いだろうということは想像に難くないということは言えると思います。
 
で、追加でやりたいことは、ある複合したキーワードで検索したいという事なので、
その辞書がなければ、また作らなければいけないかなーというのが印象です。
ということは、別途変数を用意するか、
変数をクリアして再利用するか等のことをすればいいかなぁーと思いました。
この辺はまた、識者からアドバイスがいただけると思います。
 
たとえば、
AA.xlsxのG列,H列とBB.xlsxのC列,H列が等しかった時
ならば、自ブックのシートの列を利用して数式で「=G1&H1」みたいに連結し(ブック名とシート名も必要)、
辞書的なものを作っちゃってMatch関数で検索しちゃったら作業的には
イメージしやすいかなぁ。。。。とは思っています。
速くなるか遅くなるかはやってみないと解らないですが。。。
dictionaryオブジェクトを使えば速いのでしょうが、、、、
 
元に戻りますが、Ifの条件式をAndで繋がないようにして入れ子にする、
配列変数を用意し、シート上での値の読み書きを極力減らし、メモリー上で処理をする
とするだけで格段に処理は速くなると思います。
ならば今のロジックを関数化し再利用できるように別のプロシージャにしてみるのも、
一考かとは思います。

投稿日時: 20/03/05 18:01:50
投稿者: FILETUBE

simple さん、mattuwan44さん
今回は本当にいろいろとありがとうございました。
 
大変、参考になりました。
別件でもう1点だけありますので、また宜しくお願いします。