- ベストアンサー
左側数字と同じ位置の右側で数字のチェック方法は?
- 左側数字と同じ位置の右側にある数字を8方向にチェックし、条件に応じて結果を判定する方法について質問します。
- A1~E5、G1~K5に25個の数字がランダムに入っており、同じ位置にある数字と8方向の数字を比較して結果を判定します。
- チェック対象の数字の位置と8方向の数字を比較し、同じ数字か、上下左右斜めに同じ数字があるかを判定します。
- みんなの回答 (6)
- 専門家の回答
質問者が選んだベストアンサー
QNo.9573241の延長でよければ、以下です。 Option Explicit Sub HikakuMain() Hikaku 0, 24 Hikaku 30, 54 Hikaku 60, 84 Hikaku 90, 114 End Sub Sub Hikaku(ST As Long, EN As Long) Dim MyRow1 As Long Dim MyCol1 As Long Dim MyRow2 As Long Dim MyCol2 As Long Dim MyLCnt As Long Dim Rng1 As Range Dim Rng2 As Range For MyLCnt = ST To EN MyRow1 = Int(MyLCnt / 5) + 1 MyCol1 = MyLCnt Mod 5 + 1 MyRow2 = Int(MyLCnt / 5) + 1 MyCol2 = MyLCnt Mod 5 + 1 + 6 With ThisWorkbook.Sheets(1) Set Rng1 = .Cells(MyRow1, MyCol1) Set Rng2 = .Cells(MyRow2, MyCol2) .Cells((MyLCnt Mod 30) + 25, Int(MyLCnt / 30) * 2 + 1).Value = _ .Cells(MyRow1, MyCol1).Value .Cells((MyLCnt Mod 30) + 25, Int(MyLCnt / 30) * 2 + 2).Value = _ getHIkaku(Rng1, Rng2) End With Next MyLCnt End Sub Function getHIkaku(Rng1 As Range, Rng2 As Range) As String getHIkaku = "無し" If Rng2.Row <> 1 Then If Rng2.Column <> 1 Then If Rng1.Value = Rng2.Offset(-1, -1).Value Then getHIkaku = "左上" Exit Function End If End If If Rng1.Value = Rng2.Offset(-1, 0).Value Then getHIkaku = "上" Exit Function End If If Rng1.Value = Rng2.Offset(-1, 1).Value Then getHIkaku = "右上" Exit Function End If End If If Rng2.Column <> 1 Then If Rng1.Value = Rng2.Offset(0, -1).Value Then getHIkaku = "左" Exit Function End If End If If Rng1.Value = Rng2.Offset(0, 0).Value Then getHIkaku = "同じ" Exit Function End If If Rng1.Value = Rng2.Offset(0, 1).Value Then getHIkaku = "右" Exit Function End If If Rng2.Column <> 1 Then If Rng1.Value = Rng2.Offset(1, -1).Value Then getHIkaku = "左下" Exit Function End If End If If Rng1.Value = Rng2.Offset(1, 0).Value Then getHIkaku = "下" Exit Function End If If Rng1.Value = Rng2.Offset(1, 1).Value Then getHIkaku = "右下" Exit Function End If End Function
その他の回答 (5)
- bunjii
- ベストアンサー率43% (3589/8249)
>1つ目の検索結果は、”A25から下にA1~E5までの数字25個を縦に並べて右側に検索結果を載せる。 関数でも出来ないことはありませんが作業用シートを使い複雑な数式を使わなければなりませんのでVBAを使うことがベターかと思います。 既に回答が出たようなので質問は終了ですよね? 蛇足ですが、あなたの技量では処理不可と思われますのでプログラマーに有償で依頼することをご検討ください。
お礼
ありがとうございました。 また、お知恵をお借りする事があればよろしくお願いします。
- SI299792
- ベストアンサー率47% (772/1616)
わざとわからないように質問して違うと言う。回答者いじめですか。 こう出してほしいという、図を載せるべきです。 A25から縦1列に出すのですか。こうですか? ' Option Explicit ' Sub Macro1() ' Dim Table As Variant Dim Cell1 As Range Dim Cell2 As Range Dim Index As Integer Dim Row As Integer ' [A25:A127].ClearContents Table = Array("左上", "上", "右上", "左", "同じ", "右", "左下", "下", "右下", "無し") [1:1].Insert Row = 26 ' For Each Cell1 In [A2:E24] ' If Cell1 > "00" Then Index = 0 ' For Each Cell2 In Cell1.Offset(-1, 5).Resize(3, 3) ' If Cell1 = Cell2 Then Exit For End If Index = Index + 1 Next Cell2 Cells(Row, "A") = Cell1 & ":" & Table(Index) Row = Row + 1 Index = 1 Else Row = Row + Index Index = 0 End If Next Cell1 [1:1].Delete End Sub
お礼
頂いた回答を実際にやってみました。 結果表示としてやりたかった事になりました。 言葉で書くと伝わりにくい所がでてくるので図で示した方が良いときがありますね。 今後は、図の事も考えて質問します。 ありがとうございました。
- bunjii
- ベストアンサー率43% (3589/8249)
>「左上」、「上」、「右上」が付かないと目的の達成ができません。 >またよろしくお願いします。 誤解していませんか? 1つの数式を対象範囲に適用する方法ではG1の上方3セルが無いのでF1:H2の6セルと比較することになるので、G2セルの場合と異なる数式を使わなければならないということです。 Sheetの1行目をタイトル行として比較対象を2行目以降にすれば1つの数式を対象範囲にコピーすることで目的達成できます。 添付画像のM2セルへ次の数式を入力します。 =IFERROR(INDEX($S$2:$U$4,MOD(MAX(INDEX((F1:H3=A2)*(COLUMN($A$1:$C$3)*100+ROW($A$1:$C$3)),0,0)),100),INT(MAX(INDEX((F1:H3=A2)*(COLUMN($A$1:$C$3)*100+ROW($A$1:$C$3)),0,0))/100)),"") M2セルをコピーでクリップボードへ記憶させて、M2:Q6へ貼り付けます。 次にM2:Q6セルをコピーでクリップボードへ記憶させて、M8セルへ貼り付けます。 更に、M14とM20へ貼り付ければ添付画像が仕上がります。
補足
失礼しました。 頂いた回答をよく理解してませんでした。 実際にエクセルで試したところ、貼って頂いた回答どおりとなりました。 ”空白”は”検索結果無し”の事ですね。 質問文の書き方が悪いのかもしれませんが、 質問文での期待する回答と頂いた回答結果が少し違います。 質問文での期待する回答は下記のとおりです。 1つ目の検索結果は、”A25から下にA1~E5までの数字25個を縦に並べて右側に検索結果を載せる。”ですので、 下記のようになるかと思います。 11:空白 03:中央 02:空白 05:下 01:右 16:空白 04:中央 : : 以下、E5までの数字と検索結果が続く。 2つ目~4つ目の5×5の結果は同様に以下のとおりに載せたいです。 ・2つ目の検索結果は、C25から下にA7~E11までの数字25個を縦に並べて右側に検索結果を載せる。 ・3つ目の検索結果は、E25から下にA13~E17までの数字25個を縦に並べて右側に検索結果を載せる。 ・4つ目の検索結果は、G25から下にA19~E23までの数字25個を縦に並べて右側に検索結果を載せる。 今頂いた回答の左側に検索した数字を載せる方法でもよいです。
- bunjii
- ベストアンサー率43% (3589/8249)
添付画像のような結果で良いのでしょうか? データの1行目が上の行が無いので「左上」、「上」、「右上」が検出できません。 従って、関数で処理するには1行目のみ特例になります。 A7セルへ次の数式を設定して右へコピーします。 =IFERROR(INDEX($M$1:$O$3,MOD(MAX(INDEX((F1:H2=A1)*(COLUMN($A$2:$C$3)*100+ROW($A$2:$C$3)),0,0)),100),INT(MAX(INDEX((F1:H2=A1)*(COLUMN($A$2:$C$3)*100+ROW($A$2:$C$3)),0,0))/100)),"") A8セルに次の数式を設定して右と下へコピーします。 =IFERROR(INDEX($M$1:$O$3,MOD(MAX(INDEX((F1:H3=A2)*(COLUMN($A$1:$C$3)*100+ROW($A$1:$C$3)),0,0)),100),INT(MAX(INDEX((F1:H3=A2)*(COLUMN($A$1:$C$3)*100+ROW($A$1:$C$3)),0,0))/100)),"")
お礼
新年早々、回答頂きありがとうございます。 >データの1行目が上の行が無いので「左上」、「上」、「右上」が検出できません。 >従って、関数で処理するには1行目のみ特例になります。 「左上」、「上」、「右上」が付かないと目的の達成ができません。 またよろしくお願いします。
- SI299792
- ベストアンサー率47% (772/1616)
このように質問が多いので、かすを増やした場合の改造点も挙げておきます。 ' Option Explicit ' Sub Macro1() ' Dim Table As Variant Dim Cell1 As Range Dim Cell2 As Range Dim Index As Integer ' Table = Array("左上", "上", "右上", "左", "中央", "右", "左下", "下", "右下", "無し") [1:1].Insert ' For Each Cell1 In [A2:E24] ' ここで範囲指定をする。実際の範囲より1段下を指定。 Index = 0 If Cell1 > "00" Then ' For Each Cell2 In Cell1.Offset(-1, 5).Resize(3, 3) ' ここの5が横の数字がいくつあるか If Cell1 = Cell2 Then Exit For End If Index = Index + 1 Next Cell2 Cell1.Offset(24) = Table(Index) ' ここの24で、結果を24桁下に表示 End If Next Cell1 ' [1:1].Delete End Sub
補足
新年早々、早速の回答頂きありがとうございます。 今年もよろしくお願いします。 そして、私の質問パターンを考慮してソースにコメント文までつけて頂きありがとうございます。 そんな中、大変恐縮ですが、質問文での期待する回答と頂いた回答結果が少し違います。 質問文での期待する回答は下記のとおりです。 1つ目の検索結果は、”A25から下にA1~E5までの数字25個を縦に並べて右側に検索結果を載せる。”ですので、 下記のようになるかと思います。 11:無し 3:中央 2:無し 5:下 1:右 16:無し 4:中央 : : 以下、E5まで続く。 2つ目~4つ目の5×5の結果は同様に以下のとおりに載せたいです。 ・2つ目の検索結果は、C25から下にA7~E11までの数字25個を縦に並べて右側に検索結果を載せる。 ・3つ目の検索結果は、E25から下にA13~E17までの数字25個を縦に並べて右側に検索結果を載せる。 ・4つ目の検索結果は、G25から下にA19~E23までの数字25個を縦に並べて右側に検索結果を載せる。 今頂いた回答の左側に検索した数字を載せる方法でもよいです。
お礼
ずーっと、「回答こないかなー」と待ってました。 頂いた回答で実際にやってみてドンピシャでした。 ありがとうございました。