いつもお世話になっております。

質問

いつもお世話になっております。
WindowsVista環境に下記コードを記載したマクロファイル(Excel2007)があります。

★コード★

Sub MACTH()

'変数宣言-----------------------------------------------------------------

'オブジェクト変数宣言
Dim TODAY_START_CELL As Object
Dim TODAY_UPLOAD_START_CELL As Object
Dim TODAY_UPLOAD_START_STATUS_CELL As Object

'カウント変数宣言
Dim Y_GOUKEI As Integer

'その他変数宣言
Dim Y_COLUMN1 As String
Dim A_COLUMN1 As String
Dim A_COLUMN2 As String
Dim A_COLUMN3 As String
Dim CELL_COLOR1 As String
Dim CELL_COLOR2 As String

'変数設定-----------------------------------------------------------------

'オブジェクト変数設定
Set TODAY_START_CELL = Worksheets("test").Range("B5")
Set TODAY_UPLOAD_START_CELL = Worksheets("test").Range("D5")
Set TODAY_UPLOAD_START_STATUS_CELL = Worksheets("test").Range("I5")

'配列変数設定
STATUS_MSG = Array("完了", "待ち", "確認")

'その他変数設定
Y_COLUMN1 = "B"
A_COLUMN1 = "D"
A_COLUMN2 = "I"
A_COLUMN3 = "J"
CELL_COLOR1 = -4142
CELL_COLOR2 = 40

'処理開始-----------------------------------------------------------------

TODAY_START_CELL.Select
Y_GOUKEI = ActiveCell.End(xlDown).Row

TODAY_UPLOAD_START_STATUS_CELL.Select
Do Until ActiveCell.Value = ""
For iii = 0 To 2
If InStr(ActiveCell.Value, STATUS_MSG(iii)) > 0 Then
Range(Cells(ActiveCell.Row, A_COLUMN1), Cells(ActiveCell.Offset(0, 5).Row, A_COLUMN2)).Interior.ColorIndex = CELL_COLOR2
End If
Next iii
ActiveCell.Offset(1, 0).Select
Loop

End Sub

★コード★

上記マクロの実行結果は添付画像の通りです。
実際に実現したいマクロはセルD列でColorIndex 40を塗られたセル(この場合だとセルD5・7・8)の文字列
と同じ文字列があるセルB列のセル(この場合だとセルB5・6・8)も同様にColorIndex 40を塗りたいのです。

うまく上記コードに組み込めますでしょうか？

ご存知の方がいれば、ご教授願いますでしょうか？

以上、何卒宜しくお願い致します。

回答No.1

keithin · ベストアンサー

sub macro1()
　dim h as range
　dim STATUS_MSG as variant

　STATUS_MSG = Array("完了", "待ち", "確認")
　application.replaceformat.clear
　application.replaceformat.interior.colorindex = 40

　for each h in range("D5:D" & cells(cells.rows.count, "D").end(xlup).row)
　　if not iserror(application.match(h.offset(0, 5), STATUS_MSG, 0)) then
　　　h.resize(1, 6).interior.colorindex = 40
　　　range("B:B").replace what:=h, replacement:=h, replaceformat:=True
　　end if
　next
end sub

てな具合で。

＃偶然クリックして気がつきましたが，その表題の付け方ではExcelのご質問とは気がつきませんでした。