- ベストアンサー
【改造】検索値と一緒に出ている隣接数字を知るには?
いつもお世話になっております。 どかたかご存知でしたら回答をお願いします。 1ケ月程前に下記の質問をさせていただきました。 そして回答を頂きました。これを改造したく質問します。 尚、5×6マス以外に、5×5マス、5×7マスへの改造方法も教えて頂けると助かります。 ◆改造(付け加える)要件・・・下記以外は前回と同じです。 (3)コピー後に検索値欄の値でコピーした側の4つの5×6のセル内を検索して塗潰す。 具体的には、 (1)検索値と同じ値を見つけたら、黄色でセルを塗潰す。【既存】 (2)検索値と同じ値で隣接する8方向(上、下、左、右、右下、左下、右上、左上) の数字との差が0か1なら、検索値とそのセルを赤色で塗潰す。【既存】 (3)検索値と同じ値で隣接する8方向(上、下、左、右、右下、左下、右上、左上) の数字が全て同じなら、青く塗り潰す。【追加】 〇例題 A B C D E F G H I J K L M 1 01 11 16 26 31 40 08 15 21 25 30 35 2 02 03 06 17 27 41 01 11 26 28 31 36 3 04 09 12 19 22 42 02 03 06 16 17 37 4 05 13 14 23 29 43 04 09 12 22 27 38 5 07 10 18 20 24 27 05 13 19 23 29 39 6 7 04 13 16 30 31 33 05 08 20 22 26 37 8 02 15 17 24 29 34 01 03 07 18 19 38 9 01 03 07 19 25 35 04 12 14 16 25 39 10 11 12 14 21 27 36 10 11 21 23 27 40 11 06 09 10 23 28 37 06 08 09 20 28 41 複写数:01 ※最大1~43の数字が入る。 検索値:01 ※最大43個の数字が右に並ぶ。 〇結果 A1、H2、A9、H8:01が黄色で塗潰される。 A2、H3、A8 :02が赤色で塗潰される。 B2、I3、B9、I8 :03が青色で塗潰される。 〇青色を塗潰す説明 A1にある01の隣接数字は小さい順に、02、03、11 H2にある01の隣接数字は小さい順に、02、03、08、11、15 A9にある01の隣接数字は小さい順に、02、03、11、12、15 H8にある01の隣接数字は小さい順に、03、04、05、08、12 01が見つかった4か所全てに出現している隣接数字は03なので03を青色で塗潰す。 逆に03を検索値とした場合は、 B2にある03接数字は小さい順に、01、02、04、06、09、11、12、16 I3にある03隣接数字は小さい順に、01、02、04、06、09、11、12、26 B9にある03隣接数字は小さい順に、01、02、07、11、12、14、15、17 I8にある0の隣接数字は小さい順に、01、04、05、07、08、12、14、20 03が見つかった4か所全てに出現している隣接数字は01、12なので、 01、12を青色で塗潰す。 ****2018/11/21の質問の内容**** 【質問】 例題の様に5×6マスが4つあり、その中を1~43の数字が重複有りで入っています。 1つ目の5×6マス:A1~F5 2つ目の5×6マス:H1~M5 3つ目の5×6マス:A7~F11 4つ目の5×6マス:H7~M11 使い方としては、 (1)複写数欄と検索値欄それぞれに値を入れます。 (2)複写数欄の数だけ、上記4つの5×6のセルを1塊りとして下にコピーする (最大:43)。 検索値欄の検索値も1つコピーする。 (3)コピー後に検索値欄の値でコピーした側の4つの5×6のセル内を検索して塗潰す。 具体的には、 (1)検索値と同じ値を見つけたら、黄色でセルを塗潰す。 (2)検索値と同じ値で隣接する8方向(上、下、左、右、右下、左下、右上、左上) の数字との差が0か1なら、検索値とそのセルを赤色で塗潰す。 〇例題 A B C D E F G H I J K L M 1 06 21 23 36 37 43 01 08 16 31 35 41 2 07 12 14 23 32 43 06 10 13 20 27 32 3 09 17 20 29 42 40 02 15 18 30 34 38 4 03 05 13 25 27 41 01 09 25 30 42 43 5 04 11 22 28 35 39 11 16 18 24 29 42 6 7 03 17 27 36 40 41 07 21 22 23 33 37 8 03 04 08 24 26 39 02 03 07 14 18 38 9 10 12 22 32 37 42 05 10 13 40 41 42 10 02 09 25 32 41 42 07 13 22 40 41 42 11 08 14 23 24 30 39 03 29 31 40 41 42 複写数:01 ※最大1~43の数字が入る。 検索値:41 ※最大43個の数字が右に並ぶ。 〇結果 M1:41が黄色で塗潰される。 E3、F3、F4 :40、41、42が赤色で塗潰される。 E7、F7 :40、41が赤色で塗潰される。 F9、E10、F10:41、42、42が赤色で塗潰される。 K9、L9、M9、K10、L10、M10、K11、L11、M11:40、41、42が赤色で塗潰される。 〇注意事項 ・使用するエクセルは2010です。 ・セルの数字は表示上、2桁で表しています。(例:1ではなく01) ・検索値欄に入力できる数字は最大43個で、1~43迄の数字です。 ・複写数欄に入力できる数字は1~43迄の1つです。 以上、よろしくお願いします。
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
検索値の数を数えれば、複写数はいらないと思うのですが。 複写数:Q1 検索値:Q2から右へ に直しました。 複写数と検索値の数が合わない場合の動作保証はしません。 ' Sub Macro1() ' Dim Col As Integer Dim IRange As Range ' Cells.Interior.Pattern = xlNone [A13:O557].ClearContents ' For Col = 0 To [Q1] - 1 Set IRange = [A1:O11].Offset(Col * 13) IRange = [A1:O11].Value Level1 IRange, Cells(2, Col + 17) Next Col End Sub サブルーチンは前と同じ
その他の回答 (1)
- SI299792
- ベストアンサー率47% (772/1616)
面白そうなので作ってみました。 前の質問のアドレスが書いてありません。 しかも質問履歴が非公開になっています。 前のプログラムが判らないので、検索値の指定方法は独自です。 まず、Q列1行目に「検索値」と入れて下さい。(タイトルなのでなくてもいい) Q列2行目から、検索値を入れます。 検索値の数だけコピーして実行します。 A1~O11 を範囲にしてあるので、改造なしで、5×7まで行けます。データのない所は空白にしておけばいいです。 青と赤がダブる場合、(差が1しかなく、隣接する全てに存在した場合)、赤を優先しています。 ' Option Explicit ' Sub Macro1() ' Dim Row As Integer Dim RowCpy As Integer Dim IRange As Range ' Cells.Interior.Pattern = xlNone [A13:O557].ClearContents ' For Row = 2 To Cells(Rows.Count, "Q").End(xlUp).Row RowCpy = Row - 2 Set IRange = [A1:O11].Offset(RowCpy * 13) IRange = [A1:O11].Value Level1 IRange, Cells(Row, "Q") Next Row End Sub ' Sub Level1(IRange As Range, ByVal Search As Integer) ' Dim Cell1 As Range Dim TableC(43) As Integer Dim Count As Integer ' For Each Cell1 In IRange ' If Cell1 = Search Then Count = Count + 1 Level2 Cell1, TableC(), Search Cell1.Interior.Color = vbYellow End If Next Cell1 ' For Each Cell1 In IRange ' If Cell1.Interior.Color <> vbBlue Then ElseIf TableC(Cell1) < Count Then Cell1.Interior.Pattern = xlNone End If Next Cell1 End Sub ' Sub Level2(Cell1 As Range, TableC() As Integer, Search As Integer) ' Dim Cell2 As Range Dim TableB(43) As Boolean Dim RowF As Boolean Dim ColF As Boolean ' RowF = Cell1.Row > 1 ColF = Cell1.Column > 1 ' For Each Cell2 In Cell1.Offset(RowF, ColF).Resize(2 - RowF, 2 - ColF) ' If Cell2 < "01" Then ElseIf Abs(Cell1 - Cell2) = 1 Then Cell2.Interior.Color = vbRed ElseIf Cell1.Address <> Cell2.Address Then Cell2.Interior.Color = vbBlue TableC(Cell2) = TableC(Cell2) + 1 - TableB(Cell2) TableB(Cell2) = True End If Next Cell2 End Sub 実際にやってみたら、 33,34,42,43 のように、1か所しかない場合、周り全部青になりました。 1か所なら見つかった1か所全てに出現している事になります。
補足
早速の回答ありがとうございます。 教えて頂いたソースを貼って実行したところやりたいことができました。 お願いばかりして恐縮ですが、 教えて頂いたソースでは、 Q2から下に検索値を入れた分だけコピーしながら、 検索する動きですが、質問文にも書いてますが、 複写数と検索値を分けた場合はどのようなソースになりますか? >複写数:※入力すると、入力値-1で下にコピーされる。最大1~43の数字が入る。 >検索値:※最大43個の検索数字が右に並ぶ。 下記の例では、複写数が03なので、コピー元から同じ内容で2つ下にコピーされた後に、 1つ目を検索値15で検索、2つ目を検索値の30で検索、3つ目を検索値の43で検索する。 例) 複写数:03 検索値:15 30 43
お礼
早速の回答ありがとうございます。 また、ワガママを聞いてください重ねてありがとうございます。 得たい結果となりました。 また、質問を見かけたら回答頂けると助かります。