比较大小并显示

jackyava

liulang0808 发表于 2017-12-18 20:15
楼主的级别已经不低了，发了那么多帖子
录制的添加底色，字体设置的代码都看不懂？

我是提问的多，级别才高。就好比这个帖子。http://club.excelhome.net/thread-1384357-1-1.html
If Cells(i, 14).Value = "盈利" Then
                Cells(i, 14).Interior.ColorIndex= 7
                Cells(i, 14).Font.ColorIndex =6
           ElseIf Cells(i, 14).Value = "持平" Then
                Cells(i, 14).Interior.ColorIndex= 10
                Cells(i, 14).Font.ColorIndex =6
           Else
                Cells(i, 14).Interior.ColorIndex= 23
                Cells(i, 14).Font.ColorIndex =2
           End If
我这么设置字体和背景颜色，总提示出错

liulang0808

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Set rzx = Nothing
   
4.     Set rzd = Nothing
   
5.     Set rdy = Nothing
   
6.     Set rjj = Nothing
   
7.     [aj:al].Copy [aa1]
   
8.     [ao:aq].Copy [ae1]
   
9.     For k = 3 To Cells(Rows.Count, "aa").End(3).Row Step 4
   
10.         For i = 27 To 33 Step 4
    
11.             If rjj Is Nothing Then
    
12.                 Set rjj = Cells(k, i + 1).Resize(2)
    
13.             Else
    
14.                 Set rjj = Union(rjj, Cells(k, i + 1).Resize(2))
    
15.             End If
    
16.             For j = k To k + 1
    
17.             If Cells(j, i) < Cells(j, i + 2) Then
    
18.                 If rzx Is Nothing Then
    
19.                     Set rzx = Cells(j, i)
    
20.                     Set rzd = Cells(j, i + 2)
    
21.                 Else
    
22.                     Set rzx = Union(rzx, Cells(j, i))
    
23.                     Set rzd = Union(rzd, Cells(j, i + 2))
    
24.                 End If
    
25.             Else
    
26.                 If Cells(j, i) > Cells(j, i + 2) Then
    
27.                     If rzx Is Nothing Then
    
28.                         Set rzx = Cells(j, i + 2)
    
29.                         Set rzd = Cells(j, i)
    
30.                     Else
    
31.                         Set rzx = Union(rzx, Cells(j, i + 2))
    
32.                         Set rzd = Union(rzd, Cells(j, i))
    
33.                     End If
    
34.                 Else
    
35.                     If rdy Is Nothing Then
    
36.                         Set rdy = Union(Cells(j, i), Cells(j, i + 2))
    
37.                     Else
    
38.                         Set rdy = Union(rdy, Cells(j, i), Cells(j, i + 2))
    
39.                     End If
    
40.                 End If
    
41.             End If
    
42.             Next j
    
43.         Next i
    
44.     Next k
    
45.     If Not rjj Is Nothing Then rjj.Interior.ColorIndex = 5: rjj.Value = "奖金"
    
46.     If Not rzd Is Nothing Then rzd.Interior.ColorIndex = 3: rzd.Value = "最大"
    
47.     If Not rzx Is Nothing Then rzx.Interior.ColorIndex = 7: rzx.Value = "最小"
    
48.     If Not rdy Is Nothing Then rdy.Interior.ColorIndex = 9: rdy.Value = "等于"
    
49.     Application.ScreenUpdating = True
    
50. End Sub

复制代码

liulang0808

颜色自己调整吧

jackyava

liulang0808 发表于 2017-12-18 21:08
颜色自己调整吧

版主，如果奖金的位置不是固定的，那代码该如何更改？谢谢指教
比较大小并显示(修改).rar (19.11 KB, 下载次数: 6)

2018-8-26 17:30 上传

点击文件名下载附件

jackyava

liulang0808 发表于 2017-12-18 21:08
颜色自己调整吧

版主，您不忙的时候，能再帮忙看下14楼的附件么，谢谢

liulang0808

jackyava 发表于 2018-8-27 14:05
版主，您不忙的时候，能再帮忙看下14楼的附件么，谢谢

老帖子，又翻出来了啊
不固定，基本上还是在三列范围内呗，可以遍历，然后逐段提取即可的

jackyava

liulang0808 发表于 2018-8-27 14:33
老帖子，又翻出来了啊
不固定，基本上还是在三列范围内呗，可以遍历，然后逐段提取即可的

我不知道该怎么改，能帮忙做一下么，谢谢

jackyava

liulang0808 发表于 2018-8-27 14:33
老帖子，又翻出来了啊
不固定，基本上还是在三列范围内呗，可以遍历，然后逐段提取即可的

帮忙做一下呗，版主，谢谢

liulang0808

1. Sub °′&#197;￥1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Dim arr(1 To 2)
   
4.     Set rzx = Nothing
   
5.     Set rzd = Nothing
   
6.     Set rdy = Nothing
   
7.     Set rjj = Nothing
   
8.     [aj:al].Copy [aa1]
   
9.     [ao:aq].Copy [ae1]
   
10.     For k = 3 To Cells(Rows.Count, "aa").End(3).Row Step 4
    
11.         For i = 27 To 33 Step 4
    
12.             Set Rng = Cells(k - 1, i).Resize(1, 3).Find("&#189;±&#189;e", lookat:=xlWhole)
    
13.             c = Rng.Column
    
14.             If rjj Is Nothing Then
    
15.                 Set rjj = Rng.Offset(1).Resize(2)
    
16.             Else
    
17.                 Set rjj = Union(rjj, Rng.Offset(1).Resize(2))
    
18.             End If
    
19.             a = 1
    
20.             For w = i To i + 2
    
21.                 If w <> c Then
    
22.                     arr(a) = w
    
23.                     a = a + 1
    
24.                 End If
    
25.             Next w
    
26.             For j = k To k + 1
    
27.             If Cells(j, arr(1)) < Cells(j, arr(2)) Then
    
28.                 If rzx Is Nothing Then
    
29.                     Set rzx = Cells(j, arr(1))
    
30.                     Set rzd = Cells(j, arr(2))
    
31.                 Else
    
32.                     Set rzx = Union(rzx, Cells(j, arr(1)))
    
33.                     Set rzd = Union(rzd, Cells(j, arr(2)))
    
34.                 End If
    
35.             Else
    
36.                 If Cells(j, arr(1)) > Cells(j, arr(2)) Then
    
37.                     If rzx Is Nothing Then
    
38.                         Set rzx = Cells(j, arr(2))
    
39.                         Set rzd = Cells(j, arr(1))
    
40.                     Else
    
41.                         Set rzx = Union(rzx, Cells(j, arr(2)))
    
42.                         Set rzd = Union(rzd, Cells(j, arr(1)))
    
43.                     End If
    
44.                 Else
    
45.                     If rdy Is Nothing Then
    
46.                         Set rdy = Union(Cells(j, arr(1)), Cells(j, arr(2)))
    
47.                     Else
    
48.                         Set rdy = Union(rdy, Cells(j, arr(1)), Cells(j, arr(2)))
    
49.                     End If
    
50.                 End If
    
51.             End If
    
52.             Next j
    
53.         Next i
    
54.     Next k
    
55.     If Not rjj Is Nothing Then rjj.Interior.ColorIndex = 5: rjj.Value = "&#189;±&#189;e"
    
56.     If Not rzd Is Nothing Then rzd.Interior.ColorIndex = 3: rzd.Value = "×&#238;′ó"
    
57.     If Not rzx Is Nothing Then rzx.Interior.ColorIndex = 7: rzx.Value = "×&#238;D&#161;"
    
58.     If Not rdy Is Nothing Then rdy.Interior.ColorIndex = 9: rdy.Value = "μèóú"
    
59.     Application.ScreenUpdating = True
    
60. End Sub

复制代码

liulang0808

附件内容供参考。。。。。。