Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1343 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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 発言[未読]
【74996】ループ抜け教えてください
質問  hama E-MAIL  - 13/11/11(月) 20:30 -
引用なし
パスワード
   ループをＡ列〜Ｄ列までにしたいのですが
どうしたらよいでしょうか？現在はLoop Until ""で何もなかったら
抜けるにしてあります。範囲を設定したいのですが初心者なのでわかりません
どなたか教えてください。

Sub 後シート色づけ()

　　Dim Ans1 As Variant
　　Dim Ans2 As Variant
　　Dim NewXcel As Long
　　Dim NewYcel As Long
　　Dim OldXcel As Long
　　Dim OldYcel As Long
　　Dim ites As Variant
　　Dim Obj1 As Variant


NewYcel = 2

Do

　　Ans1 = Sheets("後").Cells(NewYcel, 1)　　　　　　　　　　　　　　　　　　　　　
　　
　　Set Obj1 = Worksheets("前").Cells.Find(Ans1)　　　　　　　　　　　　　　　　　　
　　
　　If Obj1 Is Nothing Then　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　
　　　　Sheets("後").Cells.Find(Ans1).Interior.ColorIndex = 27　　　　　　　　　　
　　　　
　　　　Else　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

　　　　　　NewXcel = 2
　　　　　　OldXcel = 2
　　　　　　OldYcel = Worksheets("前").Cells.Find(Ans1).Row　　　　　　　　　　　　
　　　　　　
　　　　Do
　　　　　　If Worksheets("前").Cells(OldYcel, OldXcel) = Worksheets("後").Cells(NewYcel, NewXcel) Then
　　　　
　　　　　　Else
　　　　　　
　　　　　　　　Worksheets("後").Cells(NewYcel, NewXcel).Interior.ColorIndex = 27　
　　　　
　　　　　　End If
　　　　　　
　　　　　　NewXcel = NewXcel + 1　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　　　OldXcel = OldXcel + 1　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　　　Ans2 = Sheets("後").Cells(NewYcel, NewXcel)　　　　　　　　　　　　　　
　　　　　　
　　　　Loop Until Ans2 = ""　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　
　　End If
　　
　　NewYcel = NewYcel + 1　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　
　　ites = Sheets("後").Cells(NewYcel, 1)　　　　　　　　　　　　　　　　　　　　　

Loop Until ites = ""　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

End Sub
【74998】Re:ループ抜け教えてください
発言  kanabun  - 13/11/12(火) 10:01 -
引用なし
パスワード
   ▼hama さん：

インデントや変数名等 読みにくかったので（失礼）
いらぬお節介かもですが、修正してみました。
・２つの Worksheet は 変数に入れる
・外側の Do 〜 Loop は 「後」シートのA列をLoopしているようだから
　　For Each 〜 Next に変更。
・そのシートのA列の値を検索値Ans1 としているようだが、
　　セルそのもの(Rangeオブジェクト) と セルの値 は区別してコーディング
　　したい。
　　　Ans1 = c.Value


Sub 後シート色づけ3()
　Dim Ans1 As Variant
　Dim Ans2 As Variant
　Dim newX As Long
　Dim newY As Long
　Dim oldX As Long
　Dim oldY As Long
　Dim ws前 As Worksheet
　Dim ws後 As Worksheet
　Dim foundCell As Range
　Dim c As Range
　　
　　Set ws前 = Worksheets("前")
　　Set ws後 = Worksheets("後")

　　'「後」シートのA列（の値を検索値として）でループする
　　For Each c In ws後.Range("A2", _
　　　　　　　　　ws後.Cells(ws後.Rows.Count, 1).End(xlUp))
　　　　Ans1 = c.Value
　　　　'「後」シートのA列の値で「前」シートを検索
　　　　Set foundCell = ws前.Cells.Find(Ans1)
　　　　'「前」シートにみつからなければ、この値のセルを色塗り
　　　　If foundCell Is Nothing Then
　　　　　　c.Interior.ColorIndex = 27
　　　　
　　　　Else '「前」シートにこの値があったばあい
　　　　'　　　　 Ａ列〜Ｄ列まで比較・色塗りする　　…… ？
　　　　　　newX = 2
　　　　　　oldX = 2
　　　　　　oldY = ws前.Cells.Find(Ans1).Row
　　　　　　Do
　　　　　　　　If ws前.Cells(oldY, oldX).Value <> _
　　　　　　　　　 ws後.Cells(newY, newX).Value Then
　　　　　　　　　　ws後.Cells(newY, newX).Interior.ColorIndex = 27
　　　　　　　　End If
　　　　　　　　newX = newX + 1
　　　　　　　　oldX = oldX + 1
　　　　　　　　Ans2 = ws後.Cells(newY, newX)
　　　　　　Loop Until Ans2 = ""
　　　　End If
　　
　　Next c

End Sub


このように直してみると、
質問
>ループをＡ列〜Ｄ列までにしたい
は、
内側のLoop時の 検索列をＡ列〜Ｄ列までに限定したいということのようですが、
より具体的に その内側のループでやっていることを日本語で説明してもらうと、
どう書いたら良いか、レスが付きやすいと思います。
というのも、現状コードでは（A列ではなく） B列から比較を始めているように
読めるので、その点も含めて、説明が必要と思うのです。

他にも分からないところがあります。
たとえば、「後」シートのA列の値で、「前」シートのセル全体をFindしてます
が、ほんとに Cells(全セル)の検索が必要なのでしょうか？
「前」シートのほうも、A列をFindするだけで十分なのではありませんか？

なので、
各シートの 簡単なサンプルデータつきのレイアウトで説明があると
より分かりやすいのですが。
【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]）

>ループをＡ列〜Ｄ列までにしたいのですが
は やっぱり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列の値で「前」シートＡ列を検索 ◆
　　　　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
【75000】Re:ループ抜け教えてください
回答  hama E-MAIL  - 13/11/12(火) 11:02 -
引用なし
パスワード
   初心者なので分かりずらい質問すいません。
他の人が作ったものを加工したくて投稿しました。
やりたいことは
前シート
ＡＢＣＤ
あ１２　
か　４１
さ１　２


後シート
ＡＢＣＤ
か　２１　
あ２２　
た１３４

前と後のＡ列を検索してなかったら後のＡセルに色をつける
前と後のＡ列に同じ値があったら
Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
色をつけるとしたいのです。現状だと途中で空白セルがあると比較が
止まってしまいます。どう記述をしていいのかもわかりません。
大変申し訳ありません。よろしくお願いします。


▼kanabun さん：
>▼hama さん：
>
>インデントや変数名等 読みにくかったので（失礼）
>いらぬお節介かもですが、修正してみました。
>・２つの Worksheet は 変数に入れる
>・外側の Do 〜 Loop は 「後」シートのA列をLoopしているようだから
>　　For Each 〜 Next に変更。
>・そのシートのA列の値を検索値Ans1 としているようだが、
>　　セルそのもの(Rangeオブジェクト) と セルの値 は区別してコーディング
>　　したい。
>　　　Ans1 = c.Value
>
>
>Sub 後シート色づけ3()
>　Dim Ans1 As Variant
>　Dim Ans2 As Variant
>　Dim newX As Long
>　Dim newY As Long
>　Dim oldX As Long
>　Dim oldY As Long
>　Dim ws前 As Worksheet
>　Dim ws後 As Worksheet
>　Dim foundCell As Range
>　Dim c As Range
>　　
>　　Set ws前 = Worksheets("前")
>　　Set ws後 = Worksheets("後")
>
>　　'「後」シートのA列（の値を検索値として）でループする
>　　For Each c In ws後.Range("A2", _
>　　　　　　　　　ws後.Cells(ws後.Rows.Count, 1).End(xlUp))
>　　　　Ans1 = c.Value
>　　　　'「後」シートのA列の値で「前」シートを検索
>　　　　Set foundCell = ws前.Cells.Find(Ans1)
>　　　　'「前」シートにみつからなければ、この値のセルを色塗り
>　　　　If foundCell Is Nothing Then
>　　　　　　c.Interior.ColorIndex = 27
>　　　　
>　　　　Else '「前」シートにこの値があったばあい
>　　　　'　　　　 Ａ列〜Ｄ列まで比較・色塗りする　　…… ？
>　　　　　　newX = 2
>　　　　　　oldX = 2
>　　　　　　oldY = ws前.Cells.Find(Ans1).Row
>　　　　　　Do
>　　　　　　　　If ws前.Cells(oldY, oldX).Value <> _
>　　　　　　　　　 ws後.Cells(newY, newX).Value Then
>　　　　　　　　　　ws後.Cells(newY, newX).Interior.ColorIndex = 27
>　　　　　　　　End If
>　　　　　　　　newX = newX + 1
>　　　　　　　　oldX = oldX + 1
>　　　　　　　　Ans2 = ws後.Cells(newY, newX)
>　　　　　　Loop Until Ans2 = ""
>　　　　End If
>　　
>　　Next c
>
>End Sub
>
>
>このように直してみると、
>質問
>>ループをＡ列〜Ｄ列までにしたい
>は、
>内側のLoop時の 検索列をＡ列〜Ｄ列までに限定したいということのようですが、
>より具体的に その内側のループでやっていることを日本語で説明してもらうと、
>どう書いたら良いか、レスが付きやすいと思います。
>というのも、現状コードでは（A列ではなく） B列から比較を始めているように
>読めるので、その点も含めて、説明が必要と思うのです。
>
>他にも分からないところがあります。
>たとえば、「後」シートのA列の値で、「前」シートのセル全体をFindしてます
>が、ほんとに Cells(全セル)の検索が必要なのでしょうか？
>「前」シートのほうも、A列をFindするだけで十分なのではありませんか？
>
>なので、
>各シートの 簡単なサンプルデータつきのレイアウトで説明があると
>より分かりやすいのですが。
【75001】Re:ループ抜け教えてください
発言  kanabun  - 13/11/12(火) 12:03 -
引用なし
パスワード
   ▼hama さん：

>やりたいことは
>前シート
>ＡＢＣＤ
>あ１２　
>か　４１
>さ１　２
>
>
>後シート
>ＡＢＣＤ
>か　２１　
>あ２２　
>た１３４
>
>前と後のＡ列を検索してなかったら後のＡセルに色をつける
>前と後のＡ列に同じ値があったら
>Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
>色をつけるとしたいのです。現状だと途中で空白セルがあると比較が
>止まってしまいます。どう記述をしていいのかもわかりません。

ということでしたら、
> 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列の値で「前」シートＡ列を検索 ◆
　　　　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

のように直してください。
【75002】Re:ループ抜け教えてください
お礼  hama E-MAIL  - 13/11/12(火) 13:30 -
引用なし
パスワード
   kanabun さん短時間で回答、本当にありがとう
ございます。
回答を元に修正しました。ばっちりです。

一方が空白セルで、他方に値があると色塗りするでＯＫです。

感謝です。今後ともよろしくお願いいたします。

▼kanabun さん：
>▼hama さん：
>
>>やりたいことは
>>前シート
>>ＡＢＣＤ
>>あ１２　
>>か　４１
>>さ１　２
>>
>>
>>後シート
>>ＡＢＣＤ
>>か　２１　
>>あ２２　
>>た１３４
>>
>>前と後のＡ列を検索してなかったら後のＡセルに色をつける
>>前と後のＡ列に同じ値があったら
>>Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
>>色をつけるとしたいのです。現状だと途中で空白セルがあると比較が
>>止まってしまいます。どう記述をしていいのかもわかりません。
>
>ということでしたら、
>> 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列の値で「前」シートＡ列を検索 ◆
>　　　　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
>
>のように直してください。
【75005】Re:ループ抜け教えてください
質問  hama E-MAIL  - 13/11/12(火) 20:28 -
引用なし
パスワード
   kanabunさん、度々申し訳ありません。
もう１つ出来ますでしょうか
現在は後シートと前シートを比較して後シートに色つけを
していますが
逆に前シートを後シートと比較して違う色を付ける
ことができますでしょうか？
１つのマクロ実行で前と後の違いを色で判別したいのです。
よろしくお願いします。


▼kanabun さん：
>▼hama さん：
>
>>やりたいことは
>>前シート
>>ＡＢＣＤ
>>あ１２　
>>か　４１
>>さ１　２
>>
>>
>>後シート
>>ＡＢＣＤ
>>か　２１　
>>あ２２　
>>た１３４
>>
>>前と後のＡ列を検索してなかったら後のＡセルに色をつける
>>前と後のＡ列に同じ値があったら
>>Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
>>色をつけるとしたいのです。現状だと途中で空白セルがあると比較が
>>止まってしまいます。どう記述をしていいのかもわかりません。
>
>ということでしたら、
>> 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列の値で「前」シートＡ列を検索 ◆
>　　　　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
>
>のように直してください。
【75006】Re:ループ抜け教えてください
発言  kanabun  - 13/11/12(火) 22:17 -
引用なし
パスワード
   ▼hama さん：

>逆に前シートを後シートと比較して違う色を付ける
>ことができますでしょうか？

どういうことでしょうか？

>>>前と後のＡ列を検索してなかったら後のＡセルに色をつける
>>>前と後のＡ列に同じ値があったら
>>>Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
>>>色をつける

↑この最後の「色を付ける」ところのことですか？
いまは、

>　　　　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

の部分で、比較し、ちがっていたら ws後のほうにだけ色塗りをしていますが、
これを ws前 のほうも塗りつぶせばいいってことですか？
もしそうなら、hama さん、ご自分でできますよね？

それとは別のことですか？

# それから、hama さん、スレッドをお借りします。
　これは hama さんだけに言えることではないのですが、
　全文引用は不必要です。
　必要な部分だけを引用してください。
【75007】Re:ループ抜け教えてください
回答  hama E-MAIL  - 13/11/12(火) 23:22 -
引用なし
パスワード
   ▼kanabunさん　本当にすいません。
まったくの初心者なのです。

前と後のＡ列を検索してなかったら後のＡセルに色をつける
前と後のＡ列に同じ値があったら
Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
前も後も色をつけたいのです。
↑新しい要素

>　　　　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


の部分で、比較し、ちがっていたら ws後のほうにだけ色塗りをしていますが、
これを ws前 のほうも塗りつぶせばいいってことですか？
↑そうです。どう直せばよいかわからないのです。

もしそうなら、hama さん、ご自分でできますよね?
↑それが初心者なのでできないのです。
すいません。よろしくお願いします。
【75008】Re:ループ抜け教えてください
発言  kanabun  - 13/11/12(火) 23:45 -
引用なし
パスワード
   ▼hama さん：
>▼kanabunさん　本当にすいません。
>まったくの初心者なのです。
>
>前と後のＡ列を検索してなかったら後のＡセルに色をつける
>前と後のＡ列に同じ値があったら
>Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
>前も後も色をつけたいのです。

一行追加するだけでいいのでは？

>>　　　　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後側のセルを色塗りします
>>　　　　　　　　　　ws後.Cells(newY, x).Interior.ColorIndex = 27
　　　　　　　　　　　'他方の ws前側のセルも色塗りします
　　　　　　　　　　　ws前.Cells(oldY, x).Interior.ColorIndex = 27
>>　　　　　　　　End If
>>　　　　　　Next
>>　　　　End If

上のように、やりたいことを日本語でコメントし、そのコメントをコードに
直す練習をしばらく続けると、そのうち、VBAが書けるようになると思います。
がんばって励んでください。
【75009】Re:ループ抜け教えてください
お礼  hama E-MAIL  - 13/11/13(水) 2:15 -
引用なし
パスワード
   kanabun さん
度重なる丁寧な解説ありがとうございます。
本当に感謝です。
逆の発想など全くなかったです。
VBAをもっと勉強したいと重います。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1343 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free