Excel VBA質問箱 IV

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

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


7321 / 76732 ←次へ | 前へ→

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

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

仮に、シートレイアウトが

「前」シート

銘柄    開始    安値    高値    終値
橋本    64    40    66    56
高山    80    70    90    80
岡田    63    63    91    84
平山    90    75    95    95
須藤    80    70    83    76
加藤    73    60    80    78
君島    56    56    76    70
村上    87    73    90    87

「後」シート
銘柄    開始    安値    高値    終値
岡田    63    63    93    84
加藤    73    60    80    80
橋本    64    40    66    56
君島    56    52    76    70
高山    80    67    90    80
須藤    80    66    83    76
渡辺    87    73    90    87

のようだとすると(どちらのシートも先頭は [A1])

>ループをA列〜D列までにしたいのですが
は やっぱりB列〜E列まで ではありませんか(^^

↓◆が主な変更か所です

Sub 後シート色づけ4()
 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列〜E列まで 値を比較・色塗りする  …… ◆
      newY = c.Row
      oldY = foundCell.Row
      For x = 2 To 5 'B列〜E列
        Ans2 = ws後.Cells(newY, x).Value
        If IsEmpty(Ans2) Then
          Exit For
        ElseIf ws前.Cells(oldY, x).Value <> Ans2 Then
          ws後.Cells(newY, x).Interior.ColorIndex = 27
        End If
      Next
    End If
  
  Next c

End Sub

284 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 発言

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