[[20210122105044]] 『VBAで値が重複しているコードの一番上にだけチェメx(げん) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『VBAで値が重複しているコードの一番上にだけチェックを付けたい』(げん)

     A列    B列   C列
1行目 あいうえお 12345
2行目 かきくけこ 67890
3行目       11111  ★
4行目       11111
5行目       22222  ★
6行目       33333  ★
7行目       33333


のように、A列が空欄で、B列の値が複数あった時は複数あるうちの一番上の
C列に★印を入力していくのはどのようなコードになるか教えていただけますでしょうか。

< 使用 Excel:Excel2010、使用 OS:Windows10 >


22222は複数あるんですか?
ひとつしかないのであれば、説明が違うのでは?
「そのセルより上に、同じものがひとつもなく、
しかもA列が""であれば」という説明にならないと。
COUNTIF関数を使えばできそうですが。

(参考) 2021/01/22(金) 11:45


書き方が不適切で申し訳ございません。
A列が空欄の時にC列に★を付けたいのですが、
B列に同一の値が複数ある場合はその複数の値の一番上にだけ★を付けたいです。
関数ではなくVBAでコードを記載したいと思っております。
よろしくお願いいたします。
(げん) 2021/01/22(金) 12:00


拙いですがこんな感じでどうでしょう?
A列が空欄かつ一番上の値の時は以降の同値に反応しないパターンです。
Option Explicit

Sub test()
Dim FirstRange As Variant
Dim SecondRange As Variant
Dim n As Long
Dim m As Long
Dim p As Long
Dim A() As String
n = Cells(Rows.Count, "B").End(xlUp).Row
FirstRange = Range(Cells(1, "A"), Cells(n, "A"))
SecondRange = Range(Cells(1, "B"), Cells(n, "B"))
For n = 1 To UBound(SecondRange)

    If FirstRange(n, 1) <> "" Then
    Cells(n, "C") = ""
    Else
        If n <> 1 Then
        For m = 1 To n - 1
            If SecondRange(n, 1) = SecondRange(m, 1) Then
            Cells(n, "C") = ""
            Exit For
                If m = n - 1 Then
                Cells(n, "C") = "★"
                End If
            End If
        Next m
        End If
    End If
Next n
End Sub
A列が空白でないものを無視するならばまたコードが変わります。

(クラファン) 2021/01/22(金) 12:28


数式だと↓のようになるとおもいます。
 =IF(AND(A1="",COUNTIF($B$1:B1,B1)=1),"★","")

それが分かればVBAだろうと変わらないので、結局↓の2条件を満たす場合に★をつければよいことになりますよね。

 条件1 A列が空白(または、"")であること
 条件2 1行目からその行までの間に、B列の値が1つしかないこと

したがって、1行目から〜B列最終行までを順番に見ていき
条件1と条件2を満たす行であれば、C列に★を書き込む
という処理を考えてみてはいかがでしょうか?

ちなみに、数式のほうは思いついているということであれば、それを書き込んでから値に直すのも有効ですね

    Sub 別案()
        With Range("C1:C7")
            .Formula = "=IF(AND(A1="""",COUNTIF($B$1:B1,B1)=1),""★"","""")"
            .Value = .Value
        End With
    End Sub

(もこな2) 2021/01/22(金) 13:40


残念ながら反応がなくなってしまいましたが、研究用資料として提示しておきます。
    Sub さんぷる2()
        Stop
        Dim 行 As Long

        With ActiveSheet
            For 行 = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row
                If .Cells(行, "A").Value = "" Then
                    If WorksheetFunction.CountIf(.Range("B1", .Cells(行, "B")), .Cells(行, "B").Value) = 1 Then
                        .Cells(行, "C").Value = "★"
                    End If
                End If
            Next 行
        End With
    End Sub

(もこな2) 2021/01/22(金) 23:12


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.