エクセル 関数 条件一致セルに〇を付ける

Question

Ａ列のセルをダブルクリックすると〇が付くようにしたいのですが、Ａ列に1つだけ〇がつけられる仕組みにしたいのです。

現状では、指定した範囲のセルはいくらでも〇がつきます。

今作成してているＶＢＡは次のとおりです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True
If Intersect(Target, Range("A2:A301")) Is Nothing Then Exit Sub

Select Case Target.Value
Case ""
Target.Value = "〇"
Case "〇"""
Target.Value = ""
End Select
End Sub

また、Ａセルに〇が付くと同時に同じ行のＭ列に〇がつく。

=IF(A2="〇","〇","")

これについてはできるのですが、同時に、その行のＢセルに入力の番号とＬ列の番号が一致した場合は、その行のＭ列のセルにも〇を付けたいのですが、そこがどのような条件で作成したらいいのか悩んでいます。

Answer 1

返事よく理解せずすみません。

いずれかのセルをダブルクリックしたら
１．その行のA列に〇をつける、〇があれば消す
２．関数で
a.A列に〇があればM列に〇をつける
b.その行のB列の値でL列を検索しM列に検索したA列の〇ありなしを反映する

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngTarget As Range
Dim rngFind As Range
Dim Trow As Long
    If Target.Count > 1 Then Exit Sub  '複数セル選択禁止?
    Trow = Target.Row
    If Cells(Trow, 1).Value = "" Then
        Cells(Trow, 1).Value = "〇"
    Else
        Cells(Trow, 1).Value = ""
    End If
    
    MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
    For Trow = 2 To MaxRow
         '=IF(A3="〇","〇",IF(L3>0,IF(INDEX($A:$A,MATCH(L3,$B:$B))="〇","〇"," ")," "))
         Cells(Trow, 13).Formula = "=IF(RC[-12]=""〇"",""〇"",IF(RC[-1]>0,IF(INDEX(C1:C1,MATCH(RC[-1],C2:C2))=""〇"",""〇"","" ""),"" ""))"
    Next
End Sub

Comments

[Mkasai]

希望通りのものができました。
何度もお力を貸していただきありがとうございました。

Answer 2

２．その行のB列の値でL列を検索しM列にA1の〇ありなしを反映する
勝手な仕様つけてすみません。

　ダブルクリックされた行のA列「作成」に〇をつける、消すを繰り返す。
M列は関数でM2から最終行までコピーする。（毎回上書きです）

マクロは、下記でよろしくお願いします。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngTarget As Range
Dim rngFind As Range
Dim Trow As Long
    If Target.Count > 1 Then Exit Sub  '複数セル選択禁止?
    Trow = Target.Row
    If Cells(Trow, 1).Value = "" Then
        Cells(Trow, 1).Value = "〇"
    Else
        Cells(Trow, 1).Value = ""
    End If

　　MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
    For Trow = 2 To MaxRow
        '=IF(A2="〇","〇","")
        Cells(Trow, 13).Formula = "=IF(RC[-12]=""〇"",""〇"","" "")"
    Next
End Sub

Comments

[Mkasai]

ありがとうございます。
その行のB列の値でL列を検索しM列にA1の〇ありなしを反映する
の仕様が欲しかったのです。
どう表現していいかわからないのを教えていただき助かりました。
M列に数式を入れるという考えをなくしたらいいのでしょうか。
Aセルをクリックしたら同じ列のＭセルと、B列の値でL列を検索した結果にも同時に〇をつけたいのです。
伝え方が悪く、何度もお手数をお掛け致します。
よろしくお願いします。

[sinzou]

関数貼り付け追加し、再投稿しました。

[Mkasai]

何度もありがとうございます。
A2セルをクリックしたら、M2セルと同時にL列に1と入っているM4にも〇が付くようにはなりますか？

With ThisWorkbook.Worksheets(1).Range("L:L")
Set rngTarget = .Find(Cells(Trow, 2).Value, LookAT:=xlWhole)
If Not rngTarget Is Nothing Then
'最初のセルのアドレスを覚える
firstAddress = rngTarget.Address
Do
Cells(rngTarget.Row, 13).Value = Cells(Trow, 1).Value
Set rngTarget = .FindNext(rngTarget)
If rngTarget Is Nothing Then Exit Do
Loop Until rngTarget.Address = firstAddress

こちらを教えていただいた時には、同時に〇がついていたので希望通りの動きだったのですが、M列に入っている関数が消えてしまうのが悩みだったのです。
何度もお手数をお掛け致します。
よろしくお願いします。

[sinzou]

関数の部分を書き換えてください。
'=IF(INDEX(A:A,MATCH(L2,B:B))="〇","〇"," ")
Cells(Trow, 13).Formula = "=IF(INDEX(C1:C1,MATCH(RC[-1],C2:C2))=""〇"",""〇"","" "")"

Answer 3

いずれかのセルをダブルクリックしたら
１．その行のA列に〇をつける、〇があれば消す
２．その行のB列の値でL列を検索しM列にA1の〇ありなしを反映する

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngTarget As Range
Dim rngFind As Range
Dim Trow As Long
    If Target.Count > 1 Then Exit Sub  '複数セル選択禁止?
    Trow = Target.Row
    If Cells(Trow, 1).Value = "" Then
        Cells(Trow, 1).Value = "〇"
    Else
        Cells(Trow, 1).Value = ""
    End If
    
    With ThisWorkbook.Worksheets(1).Range("L:L")
        Set rngTarget = .Find(Cells(Trow, 2).Value, LookAT:=xlWhole)
        If Not rngTarget Is Nothing Then
            '最初のセルのアドレスを覚える
            firstAddress = rngTarget.Address
            Do
                Cells(rngTarget.Row, 13).Value = Cells(Trow, 1).Value
                 Set rngTarget = .FindNext(rngTarget)
                If rngTarget Is Nothing Then Exit Do
            Loop Until rngTarget.Address = firstAddress
        End If
    End With
End Sub

Comments

[Mkasai]

ありがとうございました。
思うように動くようになりました。
M列のセルには、
=IF(A2="〇","〇","")
のように数式を入力しているのですが、マクロを実行すると、B列の値でL列を検索した結果〇となったMセルの数式が消えてしまいます。
くり返し何度も使いたいので、Mセルの数式を残したまま使いたいです。
毎回M2セルを下までコピーするようなマクロを追加しようと思ったのですが、M2セルが検索した結果〇となってしまった場合、数式が消えているので使えないので、悩んでおります。
お力お貸しください。
よろしくお願いします。

[sinzou]

ダブルクリックされた行のA列「作成」に〇をつける、消すを繰り返す。
B列「番号」の値のあるL列「親番号」の行のM列「作成」をA列「作成」に合わせる。
を行っています。

=IF(A2="〇","〇","")は
もしA2に"〇"があれば、セルに"〇"を入れ、そうでなければ""を入れる。です
=A2 と同じですよ。

[sinzou]

M列、勝手な仕様付けてすみません

[sinzou]

もしA2に"〇"があれば、セルに"〇"を入れ、そうでなければ""を入れる。です
tたびたび　しつれいを　すみません。

Answer 4

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Rng As Range
    
    If Target.Count > 1 Then Exit Sub
    With Me.UsedRange
        Set Rng = Intersect(.Columns(1), .Offset(1))
    End With
    If Rng Is Nothing Then Exit Sub
    If Intersect(Rng, Target) Is Nothing Then Exit Sub
    
    Cancel = True
    Rng.ClearContents
    
    With Target.EntireRow
        .Range("A1").Value = "○"
        .Range("L1").Value = .Range("B1").Value
    End With
End Sub

数式は、
=IF(ISBLANK(B2),"",IF(B2=L2,"○",""))
とか。

Comments

[Mkasai]

ありがとうございました。
Aセルに1つのみ〇が付くよう設定できました。
質問時の説明がわかりにくくて申し訳ありません。
現在設定させていただきましたところ、A2セルをダブルクリックしたらM2セルに〇が付き、同時にL2セルにB2セルに入力されている数字が表示されるのですが、Lセルへの数字表示は必要なく、M2セルに〇をつけるだけにしたいのです。
また、B1セルに1と入力されていますので、L列に1と入力されいるセルがあれば、該当する行のM列のセルに〇を付けたいです。
質問時の資料でいきますと、L4セルに1と入力されているので、A2セルをダブルクリックしたら、M2セルとM4セルに〇が付く仕組みを作りたいと思っています。
また、L列に入力されている同じ数字が複数ある場合は複数のM列のセルに〇を付けたいです。
お力お貸しください。よろしくお願いします。

Answer 5

ダブルクリック時の処理

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    Range("A2:A301").Value = ""
    Target.Value = "〇"
End Sub

M2セル

=IF(AND(A2="〇",B2=L2),"〇","")

これを全M列にコピペ

Comments

[ttyp03]

スルーされた orz