ＶＢＡの記述方法について

質問

初めまして、ＶＢＡについて質問をさせてください。

「テスト資料」と「Sheet1」がそれぞれ別ブックで氏名と施設名の情報をもっています。
「テスト資料」では、氏名及び施設名が行ごとに並んでおり、氏名はＣ列、施設名はＬ列から最終列（そのときによって変動）にあります。「Sheet1」では、氏名はＧ列、施設名はＥ列にあります。

「テスト資料」の氏名及び施設名がSheet1の氏名及び施設名に一致する行を
探しだし、値がどちらも同じなら、「テスト資料」の該当する行のＡ列からＤ列と、
一致した施設名のセルを２２番の色で塗りつぶす
（上のＶＢＡでは記述方法が分からなかったため、ひとまずA列からD列を指定しています）
という処理がしたいのですが、下記を実行しても何も起こりません。

どのようにすれば処理ができるのか、どなたかご助力お願いいたします。

Dim i As Integer, j As Integer

For i = 3 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Rows.Count, 1).End(xlUp).Row

For j = 12 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Columns.Count, 1).End(xlToLeft).Column

If Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells("i,C").Value = Sheets("Sheet1").Range("G:G").Value And Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells("i,j").Value = Sheets("Sheet1").Range("E:E").Value Then

Sheets("PQ_Proc_H_EUC_E009_選考会資料").Range("A:D").Interior.ColorIndex = 22

End If
Next j
Next i

回答No.4

chie65535 · ベストアンサー

追記。

＞「Range("A" & i & ":D" & i）～」については試したものの、うまくいきませんでした。

If 略 Then
Sheets("PQ_Proc_H_EUC_E009_選考会資料").Range("A" & i & ":D" & i).Interior.ColorIndex = 22
Else
Sheets("PQ_Proc_H_EUC_E009_選考会資料").Range("A" & i & ":D" & i).Interior.ColorIndex = xlNone
End If

で上手く行きませんか？

当方が試した限りでは、上手く動作していますが？

お礼

再度ご回答いただいてありがとうございます。マクロの実行ボタンを押すと動くようにはなったのですが、実行中のまま画面が動かなくなってしまいました( ;∀;)しかし最初は全く動きもしなかったので、少し嬉しいです。ＶＢＡの記述の方法など、とても勉強になりました。
何度もご迷惑おかけするのも申し訳ないので、もう少し自分でも考えてみようと思います。本当にありがとうございました。

回答No.5

mt2015

説明が良く解りません。
もう少し具体定期な例を挙げて欲しいです。

こういう事だろうかと推理した図とコードを提示します。

Sub test()
　　Dim i As Integer, j As Integer, k, sName, sFacility
　　With Sheets("PQ_Proc_H_EUC_E009_選考会資料")
　　　　.Cells.Interior.ColorIndex = xlNone
　　　　For i = 3 To .Cells(Rows.Count, "C").End(xlUp).Row
　　For j = 12 To .Cells(i, Columns.Count).End(xlToLeft).Column
　　　　　　　　sName = .Cells(i, "C").Value
　　　　　　　　sFacility = .Cells(i, j).Value
　　　　　　　　For k = 1 To Sheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Row
　　　　　　　　　　'氏名と施設名が一致しているかチェック
　　　　　　　　　　If (sName = Sheets("Sheet1").Cells(k, "G")) * (sFacility = Sheets("Sheet1").Cells(k, "E")) Then
　　　　　　　　　　　　.Range("A" & i & ":D" & i).Interior.ColorIndex = 22
　　　　　　　　　　　　.Cells(i, j).Interior.ColorIndex = 22
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Next k
　　　　　　Next j
　　　　Next i
　　End With
End Sub

＃「別ブック」とありますが、コードを見て「別シート」の間違いと判断しました。

恐らくあちこちで拾ったコードのツギハギだと思いますし、最初はそれでも良いと思います。
ただ、少なくとも他の回答者の提言の様にステップ実行してのデバッグを行い、どこで何が間違っているのかは確認しましょう。

お礼

ご回答いただいてありがとうございます。最初は別ブックだったのですが、こちらで教えていただいてから同じブックで別シートに分ける方法に変更いたしました、説明が分かりづらく申し訳ありません<m(__)m>
お二人から回答をいただいていたのですが、最初にご回答いただいたかたと沢山やりとりをさせていただいたので、今回はchie65535さんをベストアンサーとさせていただきます、本当にありがとうございました(^o^)

回答No.3

chie65535

以下のように直してみて下さい。

For i = 3 To 略
For j = 12 To 略
For k = 2 To 略
If (略) Then
Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(i, 1).Interior.ColorIndex = 22
Else
Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(i, 1).Interior.ColorIndex = xlNone
End If
Next k
Next j
Next i

質問者さんのプログラムは

For i = 3 To 略
For j = 12 To 略
For k = 2 To 略
(略)
Next i　　←For kとFor jのNextが来る前にNext iが来ている
Next j
Next k

という間違いがあって、正常に動きません。

VBAのプログラムを一気に実行しても、ちゃんと動いているか判らないので、プログラムのどこか最初の方でブレークポイントを設定して、プログラムを中断させて、中断した場所から「F8キー」で１行づつ「ステップ実行」させて、思い通りに動いているか、トレース実行しましょう。

一気に動かして「動かない」では、お話になりません。

回答No.2

chie65535

追記。

「元々背景色22で塗り潰されていたが、データの中身が変更されて、塗り潰す必要が無くなった行」があった場合「塗り潰さないが、過去に塗り潰された状態のまま残っている」ので、このプログラムは不完全です。

ですので、以下のように「条件に一致したら22で塗り潰し、一致しなかったら塗り潰し無しにする」というプログラムにしないといけません。

また「塗り潰すセル」が「Range("A:D")」だと「AからD列のすべての行」なので「一致した行だけ」にしないといけません。

If ～～(略)～～ Then
Sheets("PQ_Proc_H_EUC_E009_選考会資料").Range("A" & i & ":D" & i).Interior.ColorIndex = 22
Else
Sheets("PQ_Proc_H_EUC_E009_選考会資料").Range("A" & i & ":D" & i).Interior.ColorIndex = xlNone
End If

あと

If Sheets("略").Cells("i,C").Value = Sheets("略").Range("G:G").Value Then

のような「１つのセルと、複数のセルの比較」は出来ません。「実行時エラー13。型が一致しません」のエラーになります。

ですので

For i = 3 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Rows.Count, 1).End(xlUp).Row
For j = 12 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Columns.Count, 1).End(xlToLeft).Column
For k = 1 To Workbooks("別のブック.XLS").Sheets("Sheet1").Cells(Workbooks("別のブック.XLS").Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row

のように、ループを三重にして

If Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(i,3).Value = Workbooks("別のブック.XLS").Sheets("Sheet1").Cells(k,7).Value And Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(i , j).Value = Workbooks("別のブック.XLS").Sheets("Sheet1").Cells(k , 5).Value Then

のように「１つのセルと、１つのセル」を比較しないといけません。

また「Cellsプロパティ」は「Cells( i , 7 )」のように「行番号の数値」と「列番号の数値」を引数にするので「Cells("i,7")」のように文字列を指定してはいけません。

＞実行しても何も起こりません。

たぶん「エラーが起きたらプログラムを終了して何もしない」と言う処理になっています。

VBAのどこかに

On Error Goto xxxxx

のような行があれば、これが「エラーが起きたらプログラムを終了して何もしない」と言う命令なので

'On Error Goto xxxxx
On Error Goto 0

のように「エラーが起きたらエラーを表示して止まる」ように変えて下さい（完成時に元に戻せるように、元の行をコメントとして残しておきましょう）

「エラーが起きたらプログラムを終了する」のままでは、間違いがあっても「何も実行しないで終わってしまう」ので、間違いが発見できません。

補足

早速ご回答いただいてありがとうございます。教えていただいたことを参考に下記のとおり修正いたしました。
・Cellsの記述を修正
・ループを三重にする
・別々のブックにあったデータを１つのブックの別シートに分ける

しかし、「Nextで指定された変数の参照が不正です。」と表示されうまくいきませんでした。

また、「エラーが起きたらエラーを表示して止まる」と、「Range("A" & i & ":D" & i）～」については試したものの、うまくいきませんでした。
「":D"」のあたりの式が誤っていると表示されます。
引き続き可能であればご教示いただけると助かります、どうぞよろしくお願いいたします。

Dim i As Integer, j As Integer, k As Integer

For i = 3 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Rows.Count, 1).End(xlUp).Row

For j = 12 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Columns.Count, 1).End(xlToLeft).Column

For k = 2 To Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

If Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(i, 3).Value = Sheets("Sheet1").Cells(k, 7).Value And Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(i, j).Value = Sheets("Sheet1").Cells(k, 5).Value Then

Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(i, 1).Interior.ColorIndex = 22

End If
Next i
Next j
Next k

回答No.1

chie65535

＞「テスト資料」と「Sheet1」がそれぞれ別ブック

以下のIF文は

If Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells("i,C").Value = Sheets("Sheet1").Range("G:G").Value And Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells("i,j").Value = Sheets("Sheet1").Range("E:E").Value Then

「現在のワークブックの『PQ_Proc_H_EUC_E009_選考会資料』シート」と「現在のワークブックの『Sheet1』シート」を比較しています。

質問文には『「テスト資料」と「Sheet1」がそれぞれ別ブック』と書かれているので、このVBAは、目的を果たせません。

以下のVBAを「テスト資料.XLS」ブックに記録して、「別のブック.XLS」ブックのSheet1シートにデータを入力して「別のブック.XLS」に保存して、実行してみて下さい。

Dim i As Integer, j As Integer

'別のブックを開く
Workbooks.Open "別のブック.XLS"

For i = 3 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Rows.Count, 1).End(xlUp).Row

For j = 12 To Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells(Columns.Count, 1).End(xlToLeft).Column

If Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells("i,C").Value = Workbooks("別のブック.XLS").Sheets("Sheet1").Range("G:G").Value And Sheets("PQ_Proc_H_EUC_E009_選考会資料").Cells("i,j").Value = Workbooks("別のブック.XLS").Sheets("Sheet1").Range("E:E").Value Then

Sheets("PQ_Proc_H_EUC_E009_選考会資料").Range("A:D").Interior.ColorIndex = 22

End If
Next j
Next i

'別のブックを閉じる
Workbooks("別のブック.XLS").Close