[[20210122105044]]　『VBAで値が重複しているコードの一番上にだけチェメx（げん）　ページの最後に飛ぶ

『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だろうと変わらないので、結局↓の２条件を満たす場合に★をつければよいことになりますよね。

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

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

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

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

（もこな２） 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

（もこな２） 2021/01/22(金) 23:12

コメント返信：

[ 一覧(最新更新順) ]

[[20210122105044]] 『VBAで値が重複しているコードの一番上にだけチェメx（げん） ページの最後に飛ぶ

[[20210122105044]]　『VBAで値が重複しているコードの一番上にだけチェメx（げん）　ページの最後に飛ぶ