求助大神~VBA怎么对两列数据进行对比并注色

zhuyan0502

求各位老师解惑,对两个sheet表单的两列数据进行比对：

（第一点和第二点类似，第三四两点类似，老师解答其中一种就可以）

1、根据两个sheet页中的“借款人”字段进行匹配，把第一个sheet“规模资产质量”页的“当期闭口余额” 和 第二个sheet页“产能过剩行业授信余额清单”中的“合计”字段作对比，不一致则把第一个sheet页中“当前闭口余额”对应的单元格标红。

2、根据两个sheet页中的“借款人”字段进行匹配，把第一个sheet“规模资产质量”页的“当期五级分类” 和 第二个sheet页“产能过剩行业授信余额清单”中的“分类”字段进行比对。如果不一致，需要把“当期五级分类”中对应的单元格标注红色。

3、对sheet1中的“当期五级分类”和“上期五级分类”进行比对，如果当期五级分类小于上期五级分类，那么“当期五级分类下调”字段为“是”，否则为“否”。 判断规则为:(正常>正常1>正常2>正常3>正常4>关注>关注1>关注2>次级>次级1>次级2>可疑>损失)

4、对sheet2中的“当期风险预警”和“上期风险预警”进行比对，如果当期风险预警大于上期风险预警，那么“当期预警上调”字段为“是”，否则为“否”。 判断规则为：(红色一级>红色二级>橙色一级>橙色二级>黄色一级>黄色二级>常规预警>预警撤销>分类调不良)

如附件：

liujialin0o0

Sub 问题1()

i = Sheets(1).Cells(Rows.Count, 2).End(3).Row
j = Sheets(2).Cells(Rows.Count, 3).End(3).Row

Set arr = Sheets(1).Range(Cells(2, 2), Cells(i, 2))
Sheets(2).Activate
Set brr = Sheets(2).Range(Cells(2, 3), Cells(j, 3))
Sheets(1).Activate

For Each rn1 In arr
    For Each rn2 In brr
        If rn1 = rn2 Then
            If rn1.Offset(0, 3) <> rn2.Offset(0, 6) Then
                rn1.Offset(0, 3).Interior.ColorIndex = 3
            End If
        End If
    Next
Next

Set arr = Nothing
Set brr = Nothing
End Sub



Sub 问题3()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
For m = 1 To 13
    d(Cells(m, "O").Value) = Cells(m, "P").Value
Next

n = Cells(Rows.Count, "I").End(3).Row
Set arr = Range(Cells(2, "H"), Cells(n, "H"))

For Each Rng In arr
    If d.Item(Rng.Value) < d.Item(Rng.Offset(0, 3).Value) Then
        Rng.Offset(0, 2) = "yes"
    Else
        Rng.Offset(0, 2) = "no"
    End If
Next
End Sub


O列   P列  写入如下信息

正常        13
正常1        12
正常2        11
正常3        10
正常4        9
关注        8
关注1        7
关注2        6
次级        5
次级1        4
次级2        3
可疑        2
损失        1

zhuyan0502

liujialin0o0 发表于 2018-9-3 17:08
Sub 问题1()

i = Sheets(1).Cells(Rows.Count, 2).End(3).Row

感谢大神帮助，厉害，完美实现了我的需求，万分感谢