Excel VBA質問箱 IV

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

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


2508 / 13646 ツリー ←次へ | 前へ→

【67477】三列が合致していないセルにチェック Yoshim 10/12/8(水) 16:09 質問[未読]
【67478】Re:三列が合致していないセルにチェック Jaka 10/12/8(水) 16:20 発言[未読]
【67479】Re:三列が合致していないセルにチェック Hirofumi 10/12/8(水) 17:47 回答[未読]
【67515】Re:三列が合致していないセルにチェック Yoshim 10/12/9(木) 21:41 お礼[未読]
【67621】Re:三列が合致していないセルにチェック Yoshim 10/12/18(土) 22:27 質問[未読]
【67626】Re:三列が合致していないセルにチェック UO3 10/12/19(日) 9:05 回答[未読]
【67627】Re:三列が合致していないセルにチェック Hirofumi 10/12/19(日) 9:10 回答[未読]
【67631】Re:三列が合致していないセルにチェック UO3 10/12/19(日) 23:33 回答[未読]
【67643】Re:三列が合致していないセルにチェック Yoshim 10/12/20(月) 22:18 お礼[未読]

【67477】三列が合致していないセルにチェック
質問  Yoshim  - 10/12/8(水) 16:09 -

引用なし
パスワード
   シート1とシート2の項目の違いに関して
大分類AAはAA同士の比較で中と小との中身が異なる状況で、比較して異なる場合のみシート1の大分類の文字の色を赤くしたいような場合・・・

シート1
大分類 中 小
AA   aaa bbb
BB   bbb ccc
CC   ccc ddd
DD   ddd eee

シート2
BB   bab ccc
AA   aaa bbb
DD   ddd ege
CC   ccc ddd

コードを書いたのですが、トラぶっています、訂正に関してアドバイスお願いします。

Sub test()
Dim i As Long, k As Long
Dim R1, R2
With Sheets(2)
 For i = 2 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
 For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
  Set R1 = Sheets(1).Cells(i, 1) & Sheets(1).Cells(i, 2) & Sheets(1).Cells(i, 3)
  Set R2 = .Cells(k, 1) & .Cells(k, 2) & .Cells(k, 3)
   If R1 <> R2 Then
    Cells(i, 1).Interior.ColorIndex = 3
   End If
 Next
 Next
End With
End Sub

【67478】Re:三列が合致していないセルにチェック
発言  Jaka  - 10/12/8(水) 16:20 -

引用なし
パスワード
   ▼Yoshim さん:
>  Set R1 = Sheets(1).Cells(i, 1) & Sheets(1).Cells(i, 2) & Sheets(1).Cells(i, 3)
>  Set R2 = .Cells(k, 1) & .Cells(k, 2) & .Cells(k, 3)

あまり読んでないけど、↑これSetする必要が無いですね。
ただも文字連結だから、

RR1 = Sheets(1).Cells(i, 1) & Sheets(1).Cells(i, 2) & Sheets(1).Cells(i, 3)
ですね。

また、変数名「R1、R2、C1、C2」の類は、97時代エラーになったので、
使ってほしくない変数名です。使っている方が多いのでその人々にも。
多分、R1C1形式と勘違いしたんじゃないかと思ってました。

【67479】Re:三列が合致していないセルにチェック
回答  Hirofumi  - 10/12/8(水) 17:47 -

引用なし
パスワード
   大分類&中&小がSheets(1)に合って、Sheets(2)に無い場合で善いなら
但し、大分類&中&小でユニーク(一意)である事

Sub test_2()

  Dim i As Long, k As Long
  Dim RowEnd1 As Long
  Dim RowEnd2 As Long
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
  
  Set Ws1 = Sheets(1)
  RowEnd1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
  
  Set Ws2 = Sheets(2)
  RowEnd2 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
  
  For i = 2 To RowEnd1
    For k = 2 To RowEnd2
      If Ws1.Cells(i, 1).Value = Ws2.Cells(k, 1).Value Then
        If Ws1.Cells(i, 2).Value = Ws2.Cells(k, 2).Value Then
          If Ws1.Cells(i, 3).Value = Ws2.Cells(k, 3).Value Then
            Exit For
          End If
        End If
      End If
    Next k
    'Sheets(2)のListに無い場合
    If k > RowEnd2 Then
      Ws1.Cells(i, 1).Interior.ColorIndex = 3
    End If
  Next i
  
  Set Ws1 = Nothing
  Set Ws2 = Nothing
  
End Sub

【67515】Re:三列が合致していないセルにチェック
お礼  Yoshim  - 10/12/9(木) 21:41 -

引用なし
パスワード
   ▼Hirofumi さん:

こんばんは。
ありがとうございました。
3列の個々のセルのデータを & で繋いで、合致していなければ・・・で出来ないか、色々いじったのですが・・・出来ませんでした。
お蔭様でよく分かりました。

【67621】Re:三列が合致していないセルにチェック
質問  Yoshim  - 10/12/18(土) 22:27 -

引用なし
パスワード
   続きで質問させていただいてもよろしいでしょうか?

Hirofumi さんからいただいたこの上のコードをまねて
列単位で繋いで以下のコードをまねて書きましたが正しい結果が得られません。

理由は何故でしょうか。教えてください。


Dim i As Long, k As Long
  Dim RowEnd1 As Long
  Dim RowEnd2 As Long
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
 
  Set Ws1 = Sheets(1)
  RowEnd1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row 
  Set Ws2 = Sheets(2)
  RowEnd2 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row 
  
  For i = 2 To RowEnd1
    For k = 2 To RowEnd2
     If Ws1.Cells(i, 1) & Cells(i, 2) & Cells(i, 3) = _
       Ws2.Cells(k, 1) & Cells(k, 2) & Cells(k, 3) Then
       Exit For
     End If
   Next k
   If k > RowEnd2 Then
     Ws1.Cells(i, 1).Interior.ColorIndex = 34
   End If
  Next i

【67626】Re:三列が合致していないセルにチェック
回答  UO3  - 10/12/19(日) 9:05 -

引用なし
パスワード
   ▼Yoshim さん:

不具合原因そのものは2番目、3番目のセルにシート修飾がないことです。

If Ws1.Cells(i, 1) & Ws1.Cells(i, 2) & Ws1.Cells(i, 3) = _
       Ws2.Cells(k, 1) & Ws2.Cells(k, 2) & Ws2.Cells(k, 3) Then

で、通常はこれでいいと思いますが、文字連結した値を比較する場合

AA と ABB、AAA と BB。これらは共に AAABB となって同じと見なされます。
ですから、【セル内には登場しないと思われる特殊文字】を間に挟んで比較するのが
安全確実です。処理前にシート1の色を無色にすることも加えて、たとえば以下。

Sub Sample()
  Dim i As Long, k As Long
  Dim RowEnd1 As Long
  Dim RowEnd2 As Long
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
  Dim s1 As String, s2 As String
  
  Set Ws1 = Sheets(1)
  RowEnd1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
  Set Ws2 = Sheets(2)
  RowEnd2 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
  Ws1.Cells.Interior.ColorIndex = xlNone
  For i = 2 To RowEnd1
    For k = 2 To RowEnd2
     s1 = Ws1.Cells(i, 1) & vbTab & Ws1.Cells(i, 2) & vbTab & Ws1.Cells(i, 3)
     s2 = Ws2.Cells(k, 1) & vbTab & Ws2.Cells(k, 2) & vbTab & Ws2.Cells(k, 3)
     If s1 = s2 Then Exit For
   Next k
   If k > RowEnd2 Then
     Ws1.Cells(i, 1).Interior.ColorIndex = 34
   End If
  Next i

End Sub

【67627】Re:三列が合致していないセルにチェック
回答  Hirofumi  - 10/12/19(日) 9:10 -

引用なし
パスワード
   UO3さんの言われる様に、シートの修飾が抜けている事と

Public Sub test_3()

  Dim i As Long, k As Long
  Dim RowEnd1 As Long
  Dim RowEnd2 As Long
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
  
  Set Ws1 = Sheets(1)
  RowEnd1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
  Set Ws2 = Sheets(2)
  RowEnd2 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
  
  For i = 2 To RowEnd1
    For k = 2 To RowEnd2
'     If Ws1.Cells(i, 1) & Cells(i, 2) & Cells(i, 3) = _
'       Ws2.Cells(k, 1) & Cells(k, 2) & Cells(k, 3) Then
     If Ws1.Cells(i, 1).Value & vbTab & Ws1.Cells(i, 2).Value _
        & vbTab & Ws1.Cells(i, 3).Value = _
            Ws2.Cells(k, 1).Value & vbTab & Ws2.Cells(k, 2).Value _
                & vbTab & Ws2.Cells(k, 3).Value Then
       Exit For
     End If
   Next k
   If k > RowEnd2 Then
     Ws1.Cells(i, 1).Interior.ColorIndex = 34
   End If
  Next i

  Set Ws1 = Nothing
  Set Ws2 = Nothing
  
End Sub


例えば、以下の様なデータが有ったとします

シート1
大分類 中  小
AAA   AA  BBB
BB   BBB  CCC
CC   CCC  DDD
DD   DDD  EEE

シート2
BB   BAB  CCC
AA   AAA  BBB
DD   DDD  EGE
CC   CCC  DDD
AAA   AA  BBB

今回の質問のコードですと

     If Ws1.Cells(i, 1) & Cells(i, 2) & Cells(i, 3) = _
       Ws2.Cells(k, 1) & Cells(k, 2) & Cells(k, 3) Then

としていますので
シート1の1行目は、AAAAABBBと成ります
一方、シート2では、2行目もAAAAABBBと成り、4行目もAAAAABBBと成ります
因って、本来4行目を引っかけたいのですが先に、2行目を引っかけてしまいます
多分この様な事が起きていると思います

因みに修正したコードでは、値の間にTabコードを挟んで連結していますので、
(大分類、中、小に含まれない文字なら、特にTabで無くても構いません、例えば「:」「/」)
シート1の1行目は、AAA:AA:BBBと成ります
一方、シート2では、2行目はAA:AAA:BBBと成り、4行目はAAA:AA:BBBと成ります
因って、2行目と4行目を見分けられるので、4行目にヒットします

ただ、幾つか気に成る所が有りますので書いて置きます

1、テスト用のデータの量を揃えて(多分1000行も有れば差が出るかな?)、
 最初に示したコード「Sub test_2」と今回の「Sub test_3」の時間を比べて見て下さい
 多分、「Sub test_2」の方が速く成ると思います
 セルの読み書きは非常に遅い動作と成りますし、文字列の連結も同じく遅い動作と成ります
 「Sub test_2」の場合、大分類が違った場合、セルの比較はシート1とシート2で2回ですし
 中分類で違った場合で、4回です、小分類まで行って6回です
 「Sub test_3」では、常に6回セルから読み出し、文字列を連結する操作が加わります
 この時間の差が「Sub test_2」と「Sub test_3」の差として出て来ると思います

2、Yoshimさんのコードでは「Ws1.Cells(i, 1) & Cells(i, 2) & Cells(i, 3)」と成っていますが?
 もっと複雑なコードに成ると、此れがセル範囲を指すのか、値を指すのか勘違いの元(バグの元)に成ります
 必ず、値を示すなら「.Value」を付けましょう

3、今回(前回も含めて)のコードは、1番基本のコードで速度が出ません
 多分1000行、10000行だといやに成るほど時間が掛かる筈です
 アルゴリズム、セルの操作等を見直せば劇的に速く成ると思いますので考えて見て下さい

【67631】Re:三列が合致していないセルにチェック
回答  UO3  - 10/12/19(日) 23:33 -

引用なし
パスワード
   ▼Yoshim さん:

hirofumiさんからYoshimさんのオリジナルコードの骨格を踏まえたコードがでていますが
hirofumiさんも指摘しておられるように処理効率の面で、この構成は課題があるのかもしれません。

で、ちょっと思いついた案です。
同じ場所にフィルターをかけるのは、あまりやったことがなく、いろいろ落とし穴があるかもしれませんが。

Sheet1とSheet2の1行目のタイトルが同じであるとの前提です。

Sub SampleX()
 Dim mRow1 As Long, mRow2 As Long
 
 Application.ScreenUpdating = False
 
 With Sheets("Sheet2")
  mRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
 End With
 
 With Sheets("Sheet1")
  mRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("A2:A" & mRow1).Interior.ColorIndex = 34
  .Range("A1:C" & mRow1).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Sheets("Sheet2").Range("A1:C" & mRow2), Unique:=False
  .Range("A2").Resize(mRow1 - 1).Interior.ColorIndex = xlNone
  .ShowAllData
 End With
 
 Application.ScreenUpdating = True
 
End Sub

【67643】Re:三列が合致していないセルにチェック
お礼  Yoshim  - 10/12/20(月) 22:18 -

引用なし
パスワード
   ▼hirofumi さん UO3 さん

こんばんは。
非常に分かりやすく丁寧な説明をいただき、感謝しています。
よく理解できました。

一部速度の点でいまいち理解が進んでいません。
もう少し勉強させていただきます。

いただいたコードをエクセルに貼り付けこれからも理解を進めたいと思います。
本当にありがとうございました。
今後ともよろしくお願いします。

次から次へと疑問点がでてきて、いまワイルドカードでうまくいきません。
また質問させていただきます。教えてください。

2508 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free