一键查错的功能！

lioner_yjs · 发表于 2014-11-27 23:26

一、需求背景：

因工作需要，要重复查询若干类似表，工作量巨大。

二、所需功能：

实现点击“错误快查”按钮，将表格中错误的区域更变文字为成指定颜色。

三、错误条件：

1、一级对应基础分为12，二级对应为10，三级对应为9，四级对应为7，五级对应为5，否，则将错误区标为红色。

2、本月得分=基础分+奖分-扣分，否，则将错误区标为橙色。

3、当月的“上次积分”=上月的“累计积分”，否，则将错误区标为黄色。

4、累计积分=本月得分+上次得分，否，则将错误区标为绿色。

5、奖励=一般奖励，则累计积分-115

奖励=中级奖励，则累计积分-130

奖励=高级奖励，则累计积分-145

否，则将错误区标为蓝色。

6、考核年月的月份不连续，考核年月栏的整列字变为紫色，最后日期不为当前实际月份的上月，最后日期变为紫色。

7、1表无错，2表是显示案例

如附件：

yijianchacuo.rar (18.46 KB, 下载次数: 12)

蓝桥玄霜 · 发表于 2014-11-28 09:39

5、奖励=一般奖励，则累计积分-115
奖励=中级奖励，则累计积分-130
奖励=高级奖励，则累计积分-145
什么意思不明白。

chxw68 · 发表于 2014-11-28 09:43

Sub test()
Dim ws As Worksheet
Dim r%, i%
For Each ws In Worksheets
With ws
.Cells.Interior.ColorIndex = 0
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a1:l" & r)
For i = 3 To UBound(arr)
If Application.HLookup(arr(i, 3), [{"一级","二级","三级","四级","五级";12,10,9,7,5}], 2, False) <> arr(i, 4) Then
.Cells(i, 4).Interior.ColorIndex = 3
End If
If arr(i, 7) <> arr(i, 4) + arr(i, 5) - arr(i, 6) Then
.Cells(i, 7).Interior.ColorIndex = 4
End If
If i > 3 Then
If arr(i, 8) <> arr(i - 1, 9) Then
.Cells(i, 8).Interior.ColorIndex = 5
End If
End If
If arr(i, 9) <> arr(i, 7) + arr(i, 8) Then
.Cells(i, 9).Interior.ColorIndex = 6
End If
Select Case arr(i, 10)
Case "一般奖励"
If arr(i, 9) < 115 Then
.Cells(i, 10).Interior.ColorIndex = 7
End If
Case "中级奖励"
If arr(i, 9) < 130 Then
.Cells(i, 10).Interior.ColorIndex = 7
End If
Case "高级奖励"
If arr(i, 9) < 145 Then
.Cells(i, 10).Interior.ColorIndex = 7
End If
End Select
If i > 3 Then
If DateDiff("m", arr(i - 1, 12), arr(i, 12)) <> 1 Then
.Range("l3:l" & r).Interior.ColorIndex = 8
.Cells(i, 12).Interior.ColorIndex = 9
End If
End If
Next
End With
Next
End Sub

复制代码

chxw68 · 发表于 2014-11-28 09:48

错误单元格颜色没有按楼主要求的去设置，楼主根据需要自己去改吧。

lioner_yjs · 发表于 2014-11-28 10:19

蓝桥玄霜发表于 2014-11-28 09:39
5、奖励=一般奖励，则累计积分-115
奖励=中级奖励，则累计积分-130
奖励=高级奖励，则累计 ...

就是奖励栏是一般奖励的话，累计积分栏的数据应该减掉115，其他类似，就是这个意思。。

lioner_yjs · 发表于 2014-11-28 10:21

chxw68 发表于 2014-11-28 09:48
错误单元格颜色没有按楼主要求的去设置，楼主根据需要自己去改吧。

谢谢，我先测试一下，看看会不会用。。。

chxw68 · 发表于 2014-11-28 10:38

Sub test()
Dim ws As Worksheet
Dim r%, i%
For Each ws In Worksheets
With ws
.Cells.Interior.ColorIndex = 0
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a1:l" & r)
For i = 3 To UBound(arr)
If Application.HLookup(arr(i, 3), [{"一级","二级","三级","四级","五级";12,10,9,7,5}], 2, False) <> arr(i, 4) Then
.Cells(i, 4).Interior.ColorIndex = 3
End If
If arr(i, 7) <> arr(i, 4) + arr(i, 5) - arr(i, 6) Then
.Cells(i, 7).Interior.ColorIndex = 4
End If
If i > 3 Then
If arr(i, 8) <> arr(i - 1, 9) Then
.Cells(i, 8).Interior.ColorIndex = 5
End If
End If
If arr(i, 10) = "" Then
If arr(i, 9) <> arr(i, 7) + arr(i, 8) Then
.Cells(i, 9).Interior.ColorIndex = 6
End If
Else
Select Case arr(i, 10)
Case "一般奖励"
x = 115
Case "中级奖励"
x = 130
Case "高级奖励"
x = 145
End Select
If arr(i, 9) <> arr(i, 7) + arr(i, 8) - x Then
.Cells(i, 10).Interior.ColorIndex = 7
End If
End If
If i > 3 Then
If DateDiff("m", arr(i - 1, 12), arr(i, 12)) <> 1 Then
.Range("l3:l" & r).Interior.ColorIndex = 8
.Cells(i, 12).Interior.ColorIndex = 9
End If
End If
Next
End With
Next
End Sub

复制代码

chxw68 · 发表于 2014-11-28 10:39

原来把奖励栏意思理解错了，看了楼主5楼解释才明白。

lioner_yjs · 发表于 2014-11-28 16:00

chxw68 发表于 2014-11-28 10:39
原来把奖励栏意思理解错了，看了楼主5楼解释才明白。

感谢！可以有效果，不过回出现错误13，类型不匹配的错误。。。
不知道什么原因。。。

chxw68 · 发表于 2014-11-29 09:07

参见附件。

		自动登录	找回密码
密码			免费注册

[求助] 一键查错的功能！