ここから質問投稿すると、最大10000ポイント当たる!!!! >>

恐れ入ります、エクセルのマクロで質問があります。
ダブリ数字の有無の確認にのマクロについてです。
下記のように数字の羅列が有ります。
上の番号から順番に検索して列の中にダブった数字(2つ以上)が無いかを確認するマクロはどのように作成すればいいでしょうか?
下記の場合、238075と238220が2以上つあるので、そこが緑色になるようにしたいです。
宜しくお願い致します。

238075
238096
238220
92528
237702
92378
237662
238077
238063
238065
238208
92523
238205
238253
237702
238220
237708
238075

A 回答 (3件)

一例です。



Sub test03()
  Dim myRange As Range
  Dim c As Range

  Set myRange = Range("A1", Cells(Rows.Count, "A").End(xlUp))

  For Each c In myRange
    If Application.WorksheetFunction.CountIf(myRange, c.Value) > 1 Then
      c.Interior.ColorIndex = 10
    End If
  Next c

  Set myRange = Nothing
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます!
これこそが欲しかったマクロでした。
本当になんでこんなにマクロが素早く正確にかけるのか!?羨ましくて仕方ないです。
きっと仕事がバリバリものすごくできる方なのでしょうね。

お礼日時:2010/04/03 09:02

#2です。


おそらく、前回の質問の続きですよね。
http://oshiete1.goo.ne.jp/qa5798289.html

改めて、2パターン作ってみました。

test04: #2のコードを素直に組み込むんだものです。
    理解しやすい反面、2度ループを回すので無駄です。
test05: 前回の質問の処理の中で、だぶりを判定し色づけします。

Sub test05()
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
  Dim myRange1 As Range
  Dim myRange2 As Range
  Dim myUnionRange As Range
  Dim c1 As Range
  Dim c2 As Range
  Dim myCt As Long

  Set Ws1 = Worksheets("Sheet1")
  Set Ws2 = Worksheets("Sheet2")
  Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp))
  Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp))

  For Each c1 In myRange1
    myCt = 0
    Set myUnionRange = Nothing
    For Each c2 In myRange2
      If c2.Value = c1.Value Then
        If c2.Offset(, 1).Value = "" Then
          c1.Offset(, 1).Interior.ColorIndex = 3
        Else
          c1.Offset(, 1).Value = c2.Offset(, 1).Value
        End If
        If myUnionRange Is Nothing Then
          Set myUnionRange = c2
        Else
          Set myUnionRange = Union(c2, myUnionRange)
        End If
        myCt = myCt + 1
      End If
    Next c2
    If myCt > 1 Then
      c1.Offset(, 1).Interior.ColorIndex = 10
      myUnionRange.Interior.ColorIndex = 10
    End If
  Next c1

  Set Ws1 = Nothing
  Set Ws2 = Nothing
  Set myRange1 = Nothing
  Set myRange2 = Nothing
  Set myUnionRange = Nothing
End Sub

'---------------------------------------------------------

Sub test04()
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
  Dim myRange1 As Range
  Dim myRange2 As Range
  Dim c1 As Range
  Dim c2 As Range
  Dim myCt As Long

  Set Ws1 = Worksheets("Sheet1")
  Set Ws2 = Worksheets("Sheet2")
  Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp))
  Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp))

  For Each c1 In myRange1
    myCt = 0
    For Each c2 In myRange2
      If c2.Value = c1.Value Then
        If c2.Offset(, 1).Value = "" Then
          c1.Offset(, 1).Interior.ColorIndex = 3
        Else
          c1.Offset(, 1).Value = c2.Offset(, 1).Value
        End If
        myCt = myCt + 1
      End If
    Next c2
    If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10
  Next c1

  For Each c2 In myRange2
    If Application.WorksheetFunction.CountIf(myRange2, c2.Value) > 1 Then
      c2.Interior.ColorIndex = 10
    End If
  Next c2

  Set Ws1 = Nothing
  Set Ws2 = Nothing
  Set myRange1 = Nothing
  Set myRange2 = Nothing
End Sub
    • good
    • 0

こんばんは!


VBAでないので、参考にならなかったら無視してください。
単純に条件付書式を使った方法です。

↓の画像のようにA列にデータが入っているとします。
当方使用のExcel2003の場合ですが、
A列全てを範囲指定し、条件付書式の「数式が」を選択し
数式欄に
=COUNTIF(A:A,A1)>1
として緑を選択しています。

以上、的外れなら読み流してくださいね。m(__)m
「ダブリ数字の有無の確認にのマクロについて」の回答画像1
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング