有没有办法我可以将此代码应用于多行而不必为每一行重复呢?

时间:2019-04-07 14:23:40

标签: excel vba

我有一个相对复杂的工作表,用于安排任务。我需要根据该行中一个单元格的值对行进行自动着色。

我有一个可以执行此功能的代码,但是我想知道是否有专家可以调整该代码以查看多个不同的行并在每行上执行相同的操作,而无需我不得不重复执行数百遍代码,而只是更改范围。

因此,您可以在下面的代码中看到E10是否等于“ Y”,然后使用“无填充”对第10行中的单元格范围进行了阴影处理。该代码是否有可能在单元格E11的第11行和单元格E12的第12行等上执行相同的操作。...

按下按钮后,代码将运行。

这个想法是,如果一个人在此处被标记为Y,那么他们的行将以白色阴影显示,以允许对该行中的任务进行计划。

我已经尝试过执行此任务的条件格式设置,但是由于我们在计划任务时需要遮蔽某些单元格并且条件格式设置会覆盖它,因此无法完成此操作。

Sub Shade1()
'
' Shade1 Macro
'

'
If Range("E10").Value = "Y" Then

Range("W10:AG10,AK10:BB10").Select
Range("AK10").Activate
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End If
End Sub

如果您能提供任何帮助,那就太好了!干杯

Screenshot of Sheet

2 个答案:

答案 0 :(得分:0)

使用如下循环:

Sub Shade1()
'
    Dim s1 As String, s2 As String

    s1 = "E10"
    s2 = "W10:AG10,AK10:BB10"

    For i = 10 To 9999
        t1 = Replace(s1, "10", i)
        t2 = Replace(s2, "10", i)
        If Range(t1).Value = "Y" Then
            With Range(t2).Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next i
End Sub

使用 9999 覆盖所有数据。
无需SelectActivate

答案 1 :(得分:0)

您可以使用AutoFilter()并避免循环:

Sub Shade1()
    With Range("E8", Cells(Rows.Count, 5).End(xlUp)) ' reference column "E" cells from row 8 (header) down to last not empty one
        .AutoFilter field:=1, Criteria1:="Y" ' filter referenced range with "Y" content
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any filtered cell other then header
            With Intersect(.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow, Range("W:AG,AK:BB")).Interior ' reference intersection bewtween filtered range rows and columns W to AG and AK to BB
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
        .Parent.AutoFilterMode = False 'remove filtering
    End With
End Sub