Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3083|回复: 7

[已解决]把符合条件的值所在单元格填充相应的颜色

[复制链接]
发表于 2015-11-12 19:09 | 显示全部楼层 |阅读模式
本帖最后由 2198596388 于 2015-11-12 22:19 编辑

有个作业请大家帮帮忙,用代码怎么完成效果要求(具体效果要求在下面的附件里)先谢了!!!急
最佳答案
2015-11-12 21:49
Sub test()
    Dim A, B(3 To 5), j, k

    Rows(2).Interior.ColorIndex = 0
    For k = 3 To 5
        '1)找最值
        A = Range([a2], Cells(2, Cells(2, Columns.Count).End(1).Column + k))
        B(k) = A(1, 1 + k)
        For j = 1 To UBound(A, 2) Step 6
            If Len(A(1, j + k)) Then
                If k = 4 Then
                    If B(k) > (0 + A(1, j + k)) Then B(k) = A(1, j + k)
                Else
                    If B(k) < (0 + A(1, j + k)) Then B(k) = A(1, j + k)
                End If
            End If
        Next j

        '2)填色
        Debug.Print B(k)
        For j = 1 To UBound(A, 2) Step 6
            If B(k) = A(1, j + k) Then Cells(2, j + k).Interior.ColorIndex = k
        Next j
    Next k
End Sub
4.rar (18.2 KB, 下载次数: 9)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2015-11-12 19:11 | 显示全部楼层
把符合条件的值所在单元格填充相应的颜色(附件)http://www.excelpx.com/forum.php?mod=attachment&aid=Mzc5MTIzfDhmYzY5MjAxNjFjYjU0NDk5OWZmZjU4MmViYTRjMzQ4fDE3MTE2NzQwNjg%3D&request=yes&_f=.zip
回复

使用道具 举报

 楼主| 发表于 2015-11-12 19:12 | 显示全部楼层
把符合条件的值所在单元格填充相应的颜色(附件) 把符合条件的值所在单元格填充相应的颜色.zip (7.25 KB, 下载次数: 8)
回复

使用道具 举报

发表于 2015-11-12 21:27 | 显示全部楼层
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A, B(3 To 5), j, k

    If Target.Row = 2 Then
        Rows(2).Interior.ColorIndex = 0

        For k = 3 To 5
            '1)查找最大值
            A = Range([a2], Cells(2, Cells(2, Columns.Count).End(1).Column + k))
            For j = 1 To UBound(A, 2) Step 6
                If B(k) < A(1, j + k) Then B(k) = A(1, j + k)
            Next j

            '2)填色
            For j = 1 To UBound(A, 2) Step 6
                If B(k) = A(1, j + k) Then Cells(2, j + k).Interior.ColorIndex = k
            Next j
        Next k
    End If
End Sub

把符合条件的值所在单元格填充相应的颜色2.rar (14.85 KB, 下载次数: 3)
回复

使用道具 举报

 楼主| 发表于 2015-11-12 21:42 | 显示全部楼层
爱疯 发表于 2015-11-12 21:27
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A, B(3 To 5), j, k

老师,能设个控件按钮把代码放到控件按钮里吗?运行操作方便点。另外,您回复的附件中没有实现第二组“最小值所在单元格填充绿色“的效果呢?
回复

使用道具 举报

发表于 2015-11-12 21:49 | 显示全部楼层    本楼为最佳答案   
Sub test()
    Dim A, B(3 To 5), j, k

    Rows(2).Interior.ColorIndex = 0
    For k = 3 To 5
        '1)找最值
        A = Range([a2], Cells(2, Cells(2, Columns.Count).End(1).Column + k))
        B(k) = A(1, 1 + k)
        For j = 1 To UBound(A, 2) Step 6
            If Len(A(1, j + k)) Then
                If k = 4 Then
                    If B(k) > (0 + A(1, j + k)) Then B(k) = A(1, j + k)
                Else
                    If B(k) < (0 + A(1, j + k)) Then B(k) = A(1, j + k)
                End If
            End If
        Next j

        '2)填色
        Debug.Print B(k)
        For j = 1 To UBound(A, 2) Step 6
            If B(k) = A(1, j + k) Then Cells(2, j + k).Interior.ColorIndex = k
        Next j
    Next k
End Sub
4.rar (18.2 KB, 下载次数: 9)

评分

参与人数 1 +30 收起 理由
fjmxwrs + 30 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2015-11-12 22:17 | 显示全部楼层
爱疯 发表于 2015-11-12 21:49
Sub test()
    Dim A, B(3 To 5), j, k

老师辛苦了,谢谢老师!代码看起来好像有点复杂,但效果很好!另外,我发帖时,在编辑窗口里没有看到上传附件的窗口,只能在发表回复窗口上传附件,怎样才能够在同一层楼发帖同时上传附件呢?
回复

使用道具 举报

发表于 2015-11-13 08:58 | 显示全部楼层
2198596388 发表于 2015-11-12 22:17
老师辛苦了,谢谢老师!代码看起来好像有点复杂,但效果很好!另外,我发帖时,在编辑窗口里没有看到上传 ...

帮助贴
http://www.excelpx.com/thread-152349-1-1.html

无法上传附件怎么办?
http://www.excelpx.com/thread-340220-1-1.html


1)IE版本的原因
解决:比如,IE版本是11,会看不到附件图标。
打开IE菜单:工具 --> 兼容性视图设置(b),将网址添加到兼容列表并勾选下方的两个选项。
具体的操作可参考,兼容性视图_百度百科
http://baike.baidu.com/view/4286680.htm

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 09:01 , Processed in 0.353609 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表