请教一个数据比较的问题

凡尘158

要求：
比较B2:B15和F20:F30的数据，
当B2:B15中有和F20:F30相同的数据，并且D2:D15中的数据和G20:G30中的数据不同时，把D2:D15中不同的数据的字体改成红色；
当B2:B15中有和F20:F30相同的数据，并且D2:D15中的数据和G20:G30中的数据相同时，把D2:D15中相同的数据前面加上=

自己试着写了一下但是运行结果有点问题
0313-1.rar (7.12 KB, 下载次数: 1)

2023-12-4 12:56 上传

点击文件名下载附件

Sub 测试1()
    Dim rngB As Range, rngF As Range, rngD As Range, rngG As Range
    Dim cellB As Range, cellF As Range, cellD As Range, cellG As Range
    Set rngB = Range("B2:B15")
    Set rngF = Range("F20:F30")
    Set rngD = Range("D2:D15")
    Set rngG = Range("G20:G30")
    For Each cellB In rngB
        For Each cellF In rngF
            If cellB.Value = cellF.Value Then
                For Each cellD In rngD
                    For Each cellG In rngG
                        If cellD.Value <> cellG.Value And cellD.Row = cellB.Row Then

                            cellD.Font.Color = RGB(255, 0, 0)
                        ElseIf cellD.Value = cellG.Value And cellD.Row = cellB.Row Then
                            cellD.Value = "=" & cellD.Value
                        End If
                    Next cellG
                Next cellD
            End If
        Next cellF
    Next cellB
End Sub


运行后问题：1、原数据D列下面空白的地方也被加上了=
                    2、原数据不论是否和对比数据一致，都被改成了红色（要求是不一样的地方改成红色）

ykcbf1100

建议上传附件，便于解决问题

凡尘158

0313-1.rar (7.12 KB, 下载次数: 7)

2023-12-4 12:24 上传

点击文件名下载附件

usedrange

Sub t()
    Dim arr, brr
    Set arr = Range("b2:d10")
    brr = Range("f20:g28").Value
    For Each v In arr
        For i = 1 To UBound(brr)
            If Cells(v.Row, 2) = brr(i, 1) Then
                If Cells(v.Row, 4) = brr(i, 2) Then
                    Cells(v.Row, 4).Value = "=" & brr(i, 2)
                Else
                    Cells(v.Row, 4).Font.ColorIndex = 3
                End If
            End If
        Next i
    Next v
End Sub

凡尘158

usedrange 发表于 2023-12-4 18:40
Sub t()
    Dim arr, brr
    Set arr = Range("b2:d10")

感谢指导
用上面的代码试着运行了一下，功能基本上都实现了，
只是在数据相同的时候D列的数字前面加=号时，最下面有两个数字没有加上=号。

gwjkkkkk

请参考。。。

凡尘158

用一个很笨的方法将两个要求分了两个步骤实现了
不过这代码好像很冗余，刚学VBA，不会精简

Sub test211()
    Dim rngB As Range
    Dim rngD As Range
    Dim rngF As Range
    Dim rngG As Range
    Dim cellB As Range
    Dim cellD As Range
    Dim cellF As Range
    Dim cellG As Range
   
    Set rngB = Range("B2:B15")
    Set rngD = Range("D2:D15")
    Set rngF = Range("F20:F30")
    Set rngG = Range("G20:G30")
   
    For Each cellB In rngB
        If WorksheetFunction.CountIf(rngF, cellB.Value) > 0 Then
            Set cellF = rngF.Find(What:=cellB.Value, LookIn:=xlValues, LookAt:=xlWhole)
            Set cellG = rngG.Cells(cellF.Row - rngF.Row + 1, 1)
            Set cellD = rngD.Cells(cellB.Row - rngB.Row + 1, 1)
            If cellD.Value <> cellG.Value Then
                cellD.Font.Color = RGB(255, 0, 0)
            End If
        End If
    Next cellB
    For Each cellB In rngB
        valueToFind = cellB.Value
        Set cellF = rngF.Find(valueToFind, LookIn:=xlValues, LookAt:=xlWhole)
        If Not cellF Is Nothing Then
            Set cellD = rngD.Cells(cellB.Row - rngB.Row + 1)
            Set cellG = rngG.Cells(cellF.Row - rngF.Row + 1)
            If cellD.Value = cellG.Value And Not IsEmpty(cellD) Then
                cellD.Value = "=" & cellD.Value
            End If
        End If
    Next cellB
End Sub

凡尘158

gwjkkkkk 发表于 2023-12-4 20:24
请参考。。。

谢谢指导，运行很完美！

usedrange

凡尘158 发表于 2023-12-4 19:42
感谢指导
用上面的代码试着运行了一下，功能基本上都实现了，
只是在数据相同的时候D列的数字前面加=号 ...

不好意思，写得急，忘了把获取行数的代码完善了，只要修改一下就可以了
ro = Range("b1048576").End(xlUp).Row
ro1 = Range("f1048576").End(xlUp).Row
Set arr = Range("b2:d" & ro)
brr = Range("f20:g" & ro1).Value

saghj

这样吗
Sub test()
  Dim i%, j%
  For i = 2 To 10
    For j = 22 To 30
      If Cells(i, 1) = Cells(j, 4) And Cells(i, 3) <> Cells(j, 5) Then
        Cells(i, 3).Font.Color = vbRed
      ElseIf Cells(i, 1) = Cells(j, 4) And Cells(i, 3) = Cells(j, 5) Then
        Cells(i, 3) = "'=" & Cells(i, 3)
      End If
    Next j
  Next i
End Sub