按条件比较数值大小，并添加字体和背景颜色

jackyava · 发表于 2017-5-13 14:30

凌空一羽发表于 2017-5-13 14:24
字体颜色已回复，标题的怎么弄？原表格不是有的吗？是标题加上颜色吗？

原表格AQ:AV列全是空白的表格，希望比较后，三星，海尔，手机，电视，冰箱这几个标题也逐行加上。

我是希望字体和背景颜色是这样的，参照点背景是茶色字体是黑色加粗的，大于参照背景是红色，字体是黄色，小于参照点背景是粉色，字体是黄色，等于参照背景是海蓝，字体是白色，是不是VBA没这功能啊

凌空一羽 · 发表于 2017-5-13 14:52

jackyava 发表于 2017-5-13 14:30
原表格AQ:AV列全是空白的表格，希望比较后，三星，海尔，手机，电视，冰箱这几个标题也逐行加上。我是希 ...

Sub 凌空一羽()
Application.ScreenUpdating = False
For i = 3 To 16
'标题------------
If i Mod 4 = 3 Then
Range("bc" & i - 1 & ":be" & i - 1).Copy Cells(i - 1, "Aq")
Range("bh" & i - 1 & ":bj" & i - 1).Copy Cells(i - 1, "At")
End If
'------------标题
'内容------------
If (i - 3) Mod 4 < 2 Then '取前2个
gi = Int((i + 1) / 4) * 4 - 1
'执行只取唯一最小(大)值------------
If Application.CountIf(Cells(gi, "aw").Resize(1, 3), "<1") = 1 Then
gmin = Application.Min(Cells(gi, "aw").Resize(1, 3))
gmc = Application.Match(gmin, Cells(gi, "aw").Resize(1, 3), 0)
Else
gmax = Application.Max(Cells(gi, "aw").Resize(1, 3))
gmc = Application.Match(gmax, Cells(gi, "aw").Resize(1, 3), 0)
End If
'------------执行只取唯一最小(大)值
For j = 1 To 6
If j > 3 Then '分2个区域选择值
gb = Cells(i, "BG").Offset(0, gmc)
If Cells(i, j + 56) = gb Then
Cells(i, j + 42) = "等于参照": Cells(i, j + 42).Interior.ColorIndex = 5: Cells(i, j + 42).Font.ColorIndex = 2: Cells(i, j + 42).Font.Bold = True '颜色变化
ElseIf Cells(i, j + 56) > gb Then
Cells(i, j + 42) = "大于参照": Cells(i, j + 42).Interior.ColorIndex = 3: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
Else
Cells(i, j + 42) = "小于参照": Cells(i, j + 42).Interior.ColorIndex = 7: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
End If
If j - 3 = gmc Then Cells(i, j + 42) = "参照": Cells(i, j + 42).Interior.ColorIndex = 40: Cells(i, j + 42).Font.ColorIndex = 1: Cells(i, j + 42).Font.Bold = True
Else
ga = Cells(i, "BB").Offset(0, gmc)
If Cells(i, j + 54) = ga Then
Cells(i, j + 42) = "等于参照": Cells(i, j + 42).Interior.ColorIndex = 5: Cells(i, j + 42).Font.ColorIndex = 2: Cells(i, j + 42).Font.Bold = True
ElseIf Cells(i, j + 54) > ga Then
Cells(i, j + 42) = "大于参照": Cells(i, j + 42).Interior.ColorIndex = 3: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
Else
Cells(i, j + 42) = "小于参照": Cells(i, j + 42).Interior.ColorIndex = 7: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
End If
If j = gmc Then Cells(i, j + 42) = "参照": Cells(i, j + 42).Interior.ColorIndex = 40: Cells(i, j + 42).Font.ColorIndex = 1: Cells(i, j + 42).Font.Bold = True
End If
Next
End If
'------------ 内容
Next
Application.ScreenUpdating = True
End Sub

复制代码

jackyava · 发表于 2017-5-14 01:53

本帖最后由 jackyava 于 2017-5-14 03:04 编辑

凌空一羽发表于 2017-5-13 14:52

老师，你这个代码只能算4组数据？那有什么意义啊？BC:BE,BH:BJ列的数据有N多组呢计算前，清空一下AQ:AV区域

凌空一羽 · 发表于 2017-5-14 12:21

jackyava 发表于 2017-5-14 01:53
老师，你这个代码只能算4组数据？那有什么意义啊？BC:BE,BH:BJ列的数据有N多组呢计算前，清空一下AQ:AV区 ...

for i=3 to 16 这儿的16改为最后行……

jackyava · 发表于 2017-5-14 12:25

凌空一羽发表于 2017-5-14 12:21
for i=3 to 16 这儿的16改为最后行……

改成65536？我试过，但提示类型不匹配， QQ截图20170514121853.png

凌空一羽 · 发表于 2017-5-14 13:09

jackyava 发表于 2017-5-14 12:25
改成65536？我试过，但提示类型不匹配，

i=3 to 16 改为……
For i = 3 To Range("bc30000").End(3).Row

jackyava · 发表于 2017-5-14 13:14

凌空一羽发表于 2017-5-14 13:09
i=3 to 16 改为……
For i = 3 To Range("bc30000").End(3).Row

问题依旧，老师用附件试验一下吧

凌空一羽 · 发表于 2017-5-14 13:39

jackyava 发表于 2017-5-14 13:14
问题依旧，老师用附件试验一下吧

jackyava · 发表于 2017-5-14 13:44

本帖最后由 jackyava 于 2017-5-14 13:50 编辑

凌空一羽发表于 2017-5-14 13:39

谢谢老师耐心指点

凌空一羽 · 发表于 2017-5-14 13:51

jackyava 发表于 2017-5-14 13:44
谢谢老师耐心指点

我已经在你这贴子上回复了……，有空去看看……

类型不匹配，如何解决？
http://club.excelhome.net/thread-1345807-1-1.html
(出处: ExcelHome技术论坛)

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

[求助] 按条件比较数值大小，并添加字体和背景颜色

评分

评分

评分

浏览过的版块