Excel VBA質問箱 IV

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

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


7322 / 76735 ←次へ | 前へ→

【75001】Re:ループ抜け教えてください
発言  kanabun  - 13/11/12(火) 12:03 -

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

>やりたいことは
>前シート
>ABCD
>あ12 
>か 41
>さ1 2
>
>
>後シート
>ABCD
>か 21 
>あ22 
>た134
>
>前と後のA列を検索してなかったら後のAセルに色をつける
>前と後のA列に同じ値があったら
>Bセル→Cセル→Dセルと比較をしていってセルの値が違っていたら
>色をつけるとしたいのです。現状だと途中で空白セルがあると比較が
>止まってしまいます。どう記述をしていいのかもわかりません。

ということでしたら、
> Sub 後シート色づけ4()
で、だいたい合ってますね(^^)
変更か所は
●A列の値があったら その行の B〜D列 3列の値を比較する
●そのとき 途中に空白セルがあっても D列までチェックする
くらいかな?

Sub 後シート色づけ5()
 Dim ws前 As Worksheet
 Dim ws後 As Worksheet
 Dim Ans1 As Variant
 Dim Ans2 As Variant
 Dim newY As Long
 Dim oldY As Long
 Dim x As Long
 Dim foundCell As Range
 Dim c As Range
  
  Set ws前 = Worksheets("前")
  Set ws後 = Worksheets("後")
  ws前.Columns(1).Interior.ColorIndex = xlNone
  ws後.Columns("A:E").Interior.ColorIndex = xlNone
  
  '「後」シートのA列(の値を検索値として)でループする
  For Each c In ws後.Range("A2", _
         ws後.Cells(ws後.Rows.Count, 1).End(xlUp))
    Ans1 = c.Value
    '「後」シートのA列の値で「前」シートA列を検索 ◆
    Set foundCell = ws前.Columns(1).Find(Ans1)
    '「前」シートにみつからなければ、この値のセルを色塗り
    If foundCell Is Nothing Then
      c.Interior.ColorIndex = 27
    
    Else '「前」シートにこの値があったばあい
       '  B列〜D列まで 値を比較・色塗りする  …… ●
      newY = c.Row
      oldY = foundCell.Row
      For x = 2 To 4 'B列〜D列
        Ans2 = ws後.Cells(newY, x).Value
        If ws前.Cells(oldY, x).Value <> Ans2 Then '●●
          ws後.Cells(newY, x).Interior.ColorIndex = 27
        End If
      Next
    End If
  
  Next c

End Sub

'●● の部分は 単に空白セルだったらループを抜ける(Exit For)条件を
削除しただけですが、これだと、一方が空白セルで、他方に値があると
色塗りされます。
比較・色塗りは「空白セルでないとき」という条件をつけるなら、
そこを

 If Not IsEmpty(Ans2) Then
   If ws前.Cells(oldY, x).Value <> Ans2 Then
     処理
   End If
 End If

のように直してください。

0 hits

【74996】ループ抜け教えてください hama 13/11/11(月) 20:30 質問
【74998】Re:ループ抜け教えてください kanabun 13/11/12(火) 10:01 発言
【75000】Re:ループ抜け教えてください hama 13/11/12(火) 11:02 回答
【75001】Re:ループ抜け教えてください kanabun 13/11/12(火) 12:03 発言
【75002】Re:ループ抜け教えてください hama 13/11/12(火) 13:30 お礼
【75005】Re:ループ抜け教えてください hama 13/11/12(火) 20:28 質問
【75006】Re:ループ抜け教えてください kanabun 13/11/12(火) 22:17 発言
【75007】Re:ループ抜け教えてください hama 13/11/12(火) 23:22 回答
【75008】Re:ループ抜け教えてください kanabun 13/11/12(火) 23:45 発言
【75009】Re:ループ抜け教えてください hama 13/11/13(水) 2:15 お礼
【74999】Re:ループ抜け教えてください kanabun 13/11/12(火) 10:40 発言

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