[已解决]关于条件格式的问题

赤寮张氏

请大师们帮忙解答，急用到。

最佳答案

月排行榜 / 总排行榜

爱疯

2015-11-30 21:29

'如果连续4个或4个以上，就填充
Sub tj()
    Dim Rng, A, B(), i, j, k, s
    Set Rng = Sheets("条件").[s1:ab1202]
    A = Rng.Value
    Rng.Interior.ColorIndex = 0

    For j = 1 To UBound(A, 2)
        For i = 3 To UBound(A)
            If TypeName(A(i, j)) <> "Error" Then
                If A(i, j) <> "" And A(i, j) <> 0 Then
                    If A(i, j) > 2 Then
                        s = s + 1
                        ReDim Preserve B(1 To s)
                        B(s) = i
                    Else
                        If s >= 4 Then
                            For k = 1 To s
                                Cells(B(k), j + 18).Interior.ColorIndex = 6
                            Next k
                            Erase B
                        End If
                        s = 0
                    End If
                End If
            End If
        Next i
    Next j
End Sub
条件格式2.rar (88.3 KB, 下载次数: 3)

2015-11-30 21:28 上传

点击文件名下载附件


只要该工作簿被打开或该工作表被激活，就会自动填充好。

跳转到最佳答案楼层

爱疯

没看懂为什么A6，A27符合要求

赤寮张氏

你好，就是：A6，A9，A13，A16这4个单元格都是大于等于3，而且这4个单元格中间没有一个单元格是1或2

赤寮张氏

爱疯 发表于 2015-11-29 11:03
没看懂为什么A6，A27符合要求

你好，就是：A6，A9，A13，A16这4个单元格都是大于等于3，而且这4个单元格中间没有一个单元格是1或2

赤寮张氏

爱疯 发表于 2015-11-29 11:03
没看懂为什么A6，A27符合要求

你好，请帮忙解答，急用到

爱疯

Sub tj()
    Dim A, i%, x, s
    A = Range([a1], [a65536].End(3))
    Range("A:A").Interior.ColorIndex = 0

    For i = 1 To UBound(A)
        If A(i, 1) <> "" And A(i, 1) <> 0 Then
            If A(i, 1) > 2 Then
                s = s + 1
                If s = 1 Then x = i
                If s > 3 Then Cells(x, 1).Interior.ColorIndex = 6: s = 0
            Else
                s = 0
            End If
        End If
    Next i
End Sub
条件格式的问题.rar (17.83 KB, 下载次数: 4)

2015-11-30 16:59 上传

点击文件名下载附件



条件格式应该很麻烦吧，是用代码做的

赤寮张氏

爱疯 发表于 2015-11-30 17:01
Sub tj()
    Dim A, i%, x, s
    A = Range([a1], [a65536].End(3))

你好，vbA我不懂，修改也改不了。请帮忙完成这个表。之前的解答有一个问题，就是有5个大于等3的话，第二个也要填充。

爱疯

赤寮张氏 发表于 2015-11-30 19:37
你好，vbA我不懂，修改也改不了。请帮忙完成这个表。之前的解答有一个问题，就是有5个大于等3的话，第二个 ...

“有5个大于等3的话，第二个也要填充。”，不清楚是什么意思？

建议补充必要的说明

赤寮张氏

爱疯 发表于 2015-11-30 20:25
“有5个大于等3的话，第二个也要填充。”，不清楚是什么意思？

建议补充必要的说明

你好，就是w列，W8，W12，W16，W19，W21,W25，这几个都是大于等于3，且中间没有1或2，符合要求，W8，W12，W16都需要填充颜色（就是，向下加上本单元格有4个以上的单元格大于等于3，就填充），其他列也一样

爱疯

'如果连续4个或4个以上，就填充
Sub tj()
    Dim Rng, A, B(), i, j, k, s
    Set Rng = Sheets("条件").[s1:ab1202]
    A = Rng.Value
    Rng.Interior.ColorIndex = 0

    For j = 1 To UBound(A, 2)
        For i = 3 To UBound(A)
            If TypeName(A(i, j)) <> "Error" Then
                If A(i, j) <> "" And A(i, j) <> 0 Then
                    If A(i, j) > 2 Then
                        s = s + 1
                        ReDim Preserve B(1 To s)
                        B(s) = i
                    Else
                        If s >= 4 Then
                            For k = 1 To s
                                Cells(B(k), j + 18).Interior.ColorIndex = 6
                            Next k
                            Erase B
                        End If
                        s = 0
                    End If
                End If
            End If
        Next i
    Next j
End Sub
条件格式2.rar (88.3 KB, 下载次数: 3)

2015-11-30 21:28 上传

点击文件名下载附件


只要该工作簿被打开或该工作表被激活，就会自动填充好。