<em>excel</em> <em>vba</em>判断同范围内是否重

Sub try()
Dim rag As Range, rags As Range
Set rags = Range("B5:J11")
For Each rag In rags
If Application.WorksheetFunction.CountIf(Intersect(Range(rag.Row & ":" & rag.Row), rags), rag.Value) = 1 Then
rag.ClearContents
End If
Next
End Sub

不知道这样写是否符合e799bee5baa6e997aee7ad94e58685e5aeb9336你的意思：

Sub 测试()
Set dic = CreateObject("scripting.dictionary")
arr = Range("b10:k50")
For k = LBound(arr, 1) To UBound(arr, 1)
    For m = LBound(arr, 2) To UBound(arr, 2)
        If Not dic.exists(arr(k, m)) Then
            dic(arr(k, m)) = 1
        Else
            dic(arr(k, m)) = dic(arr(k, m)) + 1
        End If
    Next m
Next k
For k = LBound(arr, 1) To UBound(arr, 1)
    For m = LBound(arr, 2) To UBound(arr, 2)
        If dic(arr(k, m)) = 1 Then
            arr(k, m) = ""
        Else
            dic(arr(k, m)) = 1
        End If
    Next m
Next k
Range("b10:k50") = arr
End Sub

Sub s()
    Set d = CreateObject("scripting.dictionary")
    c = InputBox("请输入列标：zhidao")
    n = Cells(Rows.Count, c).End(3).Row
    For i = 1 To n
        a = Cells(i, c).Text
        If a <> "" Then
            If d.exists(a) Then
                MsgBox c & "列内容专有重复！属"
                Exit Sub
            Else
                d.Add a, ""
            End If
        End If
    Next
    MsgBox c & "列内容无重复！"
End Sub

以A1：E4区域为例，代码如下：

Sub tst()
Dim i%, j%, k%
 For i = 1 To 4
  For j = 0 To 4
   For k = 0 To 4
    If Cells(i, 1).Offset(0, j).Value = Cells(i, 1).Offset(0, k).Value And j <> k Then Cells(i, 1).Interior.ColorIndex = i + 10
   Next
  Next
 Next
End Sub

 或者下e799bee5baa6e997aee7ad94e78988e69d83366面代码也可以，

Sub tst()
Dim d As Object  '定义变量
Dim i%, j%
For i = 1 To [a65536].End(3).Row
     Set d = CreateObject("Scripting.Dictionary") '创建数据字典
     For j = 1 To Cells(i, 256).End(xlToLeft).Column
           If Cells(i, j) <> "" And WorksheetFunction.CountIf(Range("A" & i & ":IV" & i), Cells(i, j)) > 1 And Not d.exists(Cells(i, j).Value) Then
              d.Add Cells(i, j).Value, ""
           End If
     Next j
     Rows(i).ClearContents
     If d.Count > 0 Then Cells(i, 1).Resize(, d.Count) = d.keys
     Set d = Nothing
Next i
End Sub