重複データのチェック

Question

Sub 重複()
Dim rng As Range, r As Range, chkVal As Integer
Set rng = Range("A1:A30")
Set ist = Range("B1:B30")

For Each r In rng
For Each s In ist

    chkVal = Application.CountIfs(rng, r, ist, s)
        If chkVal > 1 Then
            s.Offset(0, 1).Value = "重複"
        End If
  
    Next s
Next r
End Sub

```リスト内でA列B列で複数の条件で重複がある場合にチェックが入るようにしたいのですが、
ひとつでも重複がみつかれば、それにかかる全ての行にチェックが入ってしまいます。
例：　　A列　B列
一行目　●　　△　重複　
二行目　●　　△　重複
三行目　●　　■
としたいのですが、現状三行目まで"重複"と入ってしまいます。
なにが原因なのでしょうか。

Comments

[ttyp03]

今どのように処理しているのか書かないと原因も何もわかりまへん。

[hajihaji]

すみません。コードの挿入を忘れておりました。

[ExcelVBAer]

VBAでやる理由が分かりません。数式だけの問題でしょう？

Answer 1

関数を分離してAND条件に変更したらどうですか？

変更前：
chkVal = Application.CountIfs(rng, r, ist, s)
If chkVal > 1 Then

変更後：
chkVal1 = Application.CountIf(rng, r)
chkVal2 = Application.CountIf(ist, s)
If chkVal1 > 1 And chkVal2 > 1 Then

Comments

[hajihaji]

ご回答ありがとうございます。
変更してみましたがやはり同じ動作のままです。
なにがいけないのでしょうか。

[paolo.ahn]

再度見たら、Loopが間違っていました。次のソースをコピーペで！

Sub 重複()
Dim rng As Range, r As Range, chkVal As Integer
Set rng = Range("A1:A30")
Set ist = Range("B1:B30")

For Each r In rng
chkVal1 = Application.CountIf(rng, r.value)
chkVal2 = Application.CountIf(ist, r.offset(0,1).value)
If chkVal1 > 1 And chkVal2 > 1 Then
r.Offset(0, 2).Value = "重複"
End If
Next r
End Sub

Answer 2

ループの仕方がまずいかと。
行の固まり毎に処理をしたいという前提が崩れています。

下記のようにすればどうでしょう

Dim rng As Range, r As Range, chkVal As Integer
set rng = Range("A1:B30")
Dim arng as Range: set arng = Range("A1:A30")
Dim brng as Range: set brng = Range("B1:B30")

dim row

for each r in rng.rows
    chkVal = Application.CountIfs(arng, r.Range("A1"), brng, r.Range("B1"))
    If chkVal > 1 Then
       r.Range("B1").Offset(0, 1).Value = "重複"
    End If
next

Comments

[hajihaji]

ありがとうございました。
うまくいきました。

[hajihaji]

よく見ますと、重複のチェックが入る列がひとつ多いようです。
原因がわかりましたらご教示ください。

[n_takapyon]

元のコードにかかれていたチェックのやり方を残したつもりですが。

やりた事は各行において、A列に現在の行のA列の値が存在していて、B列に現在の行の値が入っている事を確認することだと思ったのでそのように書きました。

あと、すみません、訂正が1箇所あります。
s.Offset(0,1).value = "重複"としていましたが変数がありませんので、r.range("B1").offset(0,1).value = "重複"　に修正しておきます。

[hajihaji]

ご回答ありがとうございました。
失礼しました私自身がわかっていませんでした。

Answer 3

For Each を２回かけているのは何故でしょうか？

Answer 4

単純にCellsを使って、

Dim i As Long ' for文で使うため
For i = 0 To 100
    If Cells( i, 2 ).Value = Cells( i - 1, 2 ).Value Then ' 指定列が同じ値なら
         Cells( i, 3 ).Value = "重複"
    End If
Next

みたいにしてやればいいのでは?

今回の場合は

A列, B列 の組み合わせも重要だから、もうちょっとひねる必要はあるが。

Comments

[hajihaji]

ご回答ありがとうございました。