EXCEL,写VBA,左右两列,同行之间相同数填充红加粗,还有批注

发布网友发布时间：2024-10-07 13:39

共1个回答

热心网友时间：2024-11-26 22:34

Sub kerting()
Dim r%, j%, i%, arr, brr
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
With Sheet1
        With .Cells
        .Font.ColorIndex = xlAutomatic
        .Font.TintAndShade = 0
        .Font.Bold = False
        End With
        .Cells.ClearComments
    r = .Cells(.Rows.Count, 3).End(3).Row
    arr = .Range("j" & r - 50 + 1 & ":o" & r)
    brr = .Range("c" & r - 50 + 1 & ":h" & r)
For j = 1 To UBound(brr)
    For i = 1 To UBound(arr, 2)
        d(arr(j, i)) = ""
        If d.exists(brr(j, i)) Then
                With .Cells(j + r - 50, i + 2).Font
                .Color = -16776961
                .TintAndShade = 0
                .Bold = True
                End With
            If j >= 20 Then
        d1(brr(j, i)) = d1(brr(j, i)) + 1
        .Cells(j + r - 50, i + 2).AddComment d1(brr(j, i)) & ""
        End If
        End If
    Next
  d.RemoveAll
Next
End With
Set d = Nothing
Set d1 = Nothing
End Sub

追问在不，运行了下，没效果!

能不加下你qq传表格给你看下