求一个在规定区域出现相同数值时字体变红等

lmx3517

请各位版主和老师：求一个在规定区域E3——F100内，当出现相同的数值则变红色加粗字体的“宏”的程序。这里相同的数值是我手动完成的。具体见附件，谢谢！！！

wj2368

...........

爱吃蜂蜜的狼

。。。。。。。。。。。。。。。。。。。。。。。。

vic9

Sub bvcxz()
Dim i, d, arr, rng, yy, k, r, rn, brr()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("sheet1").Range("e3:f100")
    For Each rng In arr
        i = d(rng)
        d(rng) = d(rng) + 1
        If d(rng) > 1 And rng <> "" Then
            k = k + 1
            ReDim Preserve brr(1 To k)
            brr(k) = rng
        End If
    Next
    For Each rn In Sheets("sheet1").Range("e3:f100")
        For r = 1 To UBound(brr)
            If brr(r) = rn Then
                rn.Font.ColorIndex = 3
                rn.Font.Bold = True
            End If
        Next
    Next
End Sub

LZH02620

Sub test() '将指定区域内相同单元格字体红粗
    Dim d, i, j, k, arr, brr, crr, t
    Set d = CreateObject("scripting.dictionary")
    arr = Range("e3:fd10000")
    t = Timer
    For i = 1 To 9998
        For j = 1 To 156
            If arr(i, j) <> "" Then d(arr(i, j)) = d(arr(i, j)) + 1
        Next
    Next
    brr = WorksheetFunction.Transpose(d.keys)
    crr = WorksheetFunction.Transpose(d.items)
    For k = 1 To d.Count
        If crr(k, 1) > 1 Then
            For i = 3 To 10000
                For j = 5 To 161
                    If brr(k, 1) = Cells(i, j) Then
                        Cells(i, j).Font.ColorIndex = 3
                        Cells(i, j).Font.Bold = True
                    End If
                Next
            Next
        End If
    Next
    MsgBox ("用时" & Timer - t & "秒")  
End Sub

小鹿一样

Sub 宏1()
    Range("E3:F100").Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

hcm19522

E3:F100 格式化=COUNTIF($E:$F,E3)>1

lmx3517

wj2368 发表于 2019-6-27 10:56
...........

感谢你的帮助，我试了试发现一个小问题就是字体没有加粗。

wj2368

lmx3517 发表于 2019-6-27 17:38
感谢你的帮助，我试了试发现一个小问题就是字体没有加粗。

原代码上加红色部分
Sub yy()
Application.ScreenUpdating = False
Dim ran As Range
For Each ran In [E3:f100]
If Application.WorksheetFunction.CountIf([E3:f100], ran.Value) >= 2 Then ran.Font.Color = -16776961: ran.Font.Bold = True
Next
Application.ScreenUpdating = True
End Sub

lmx3517

wj2368 发表于 2019-6-28 09:32
原代码上加红色部分
Sub yy()
Application.ScreenUpdating = False

谢谢！加红部分是有的，还需要将加红部分加粗，字体变化为加红加粗