塗りつぶしたセルの対称となるセルの数字を抜き出す2

質問

いつもお世話になっております。
もう１つよろしければ回答をお願いいたします。
【質問】
添付図の様にＡ１～Ｇ３０までに１～３７迄の数字が重複有りで入っています。
それを、Ｉ２～Ｏ２の数字で検索します。
検索できたらそのセルを赤く塗り潰します。
赤く塗りつぶしたセルがＤ列以外の場合、
対称（Ａ列の対称はＧ列、Ｂ列の対称はＦ列、Ｃ列の対象はＥ列）となる数字を
Ｉ５から下に並べる方法が知りたいです。
【注意事項】
・使用するエクセルは２０１６です。
・Ｉ２～Ｏ２に入る数字は１～３７迄で重複無しです。
・添付図は途中の４行目迄のサンプルとなっております。

以上、よろしくお願いいたします。

回答No.1

HohoPapa · ベストアンサー

もしVBAの学習が目的の質問なら
前回私が提示したコードをじっくり追い、
どこを修正すれば対応できるの試行するのも
学習の一つになると思いますヨ。

以下に今回のコードをポストし、
合わせてどこを修正したのかわかるようにしました。
'☆の行です。

Sub Sample()

　Dim RngKey As Range
　Dim RngAll As Range
　Dim RngHit As Range
　Dim PutLine As Long
　Dim RowNum As Long
　Dim ColNum As Long
　Dim KeyCol As Long

　Set RngKey = Range("I2:O2") 　'☆
　Set RngAll = Range("A1:G30")　'☆
　Set RngHit = Range("I5:I184")　'☆

　PutLine = 0

　For RowNum = 1 To RngAll.Rows.Count
　　For ColNum = 1 To RngAll.Columns.Count
　　　RngAll.Cells(RowNum, ColNum).Interior.Pattern = xlNone
　　　For KeyCol = 1 To RngKey.Columns.Count
　　　　If RngAll.Cells(RowNum, ColNum).Value = _
　　　　　　RngKey.Cells(1, KeyCol).Value Then
　　　　　RngAll.Cells(RowNum, ColNum).Interior.Color = rgbRed
　　　　　If ColNum <> 4 Then　　　　　　　　　'☆
　　　　　　PutLine = PutLine + 1
　　　　　　RngHit.Cells(PutLine, 1).Value = _
　　　　　　　RngAll.Cells(RowNum, 8 - ColNum).Value　'☆
　　　　　End If
　　　　End If
　　　Next KeyCol
　　Next ColNum
　Next RowNum

End Sub

お礼

回答いただきありがとうございます。
最初に教えていただいたソースを修正したのですが、
実行したら”実行時エラー：１００４”と出て悩んでました。
最後の☆の部分の、RowNum, 8 　をRowNum, ６としていました。
まだまだです。
ありがとうございました。