Question

我拼凑了一个代码来创建自动热图。除非我找到一些捷径，否则代码最终将长达数千行。如果有人耐心以新手级别的方式解释如何简化此步骤，那将是惊人的。一个例子是理想的，我可以很好地配合这些。

有人告诉我要为每个Case编写一个单独的例程，只包含该case的代码，然后将要受影响的Range作为参数传递给每个“ sub”。我不知道它是什么样子，所以当我自己尝试时效果不佳。下面的代码只是单元格B13的一种情况的示例。我的整个代码的情况是从1.0到5.0，以.1为增量，并且对于单元格B15，B17，B19，B21，B23，C13，C13 ...（在Sheet2中具有相应的单元格）会重复出现，因此它很快变得非常长这就是为什么在顶部具有Worksheet_Change函数的原因，因为将我的代码全部包含在内会导致“过程过长”错误。

Sub Worksheet_Change(ByVal Target As Range)
    B13   
End Sub

Sub B13(ByVal Target As Range)

If Not Intersect(Target, Range("B13")) Is Nothing Then

        Select Case Range("B13").Value

        Case 2

                With Sheets("Sheet2").Range("B11").Interior
                    .Pattern = xlPatternLinearGradient
                    .Gradient.Degree = 180
                    .Gradient.ColorStops.Clear
                End With

                With 

                     Sheets("Sheet2").Range("B11").Interior
                    .Gradient.ColorStops.Add(0)
                    .Color = RGB(253, 200, 25)
                    .TintAndShade = 0
                End With

                With 
                    Sheets("Sheet2").Range("B11").Interior
                    .Gradient.ColorStops.Add(0.04)
                    .Color = RGB(255, 192, 0)
                    .TintAndShade = 0
                End With

                With 
                    Sheets("Sheet2").Range("B11").Interior
                    .Gradient.ColorStops.Add(0.09)
                    .Color = RGB(143, 207, 80)
                    .TintAndShade = 0
                End With

                With 
                     Sheets("Sheet2").Range("B11").Interior
                    .Gradient.ColorStops.Add(0.15)
                    .Color = RGB(143, 207, 80)
                    .TintAndShade = 0
                End With

                With
                     Sheets("Sheet2").Range("B11").Interior
                    .Gradient.ColorStops.Add(1)
                    .Color = RGB(0, 176, 80)
                    .TintAndShade = 0
                   End With

End Select
End If
End Sub

我希望简化的代码可以让我为每种情况只写一次不同的渐变，然后以某种方式使用范围自动分配像元。

Answer 1

这是您可以针对的事物类型的一个示例-以分层的方式减少重复代码的数量-每个渐变类型都有一个子对象，而单个通用子对象则将每个对象应用于一个单独的梯度单元格。

Sub Tester()

    GradientOne Range("a1")
    GradientTwo Range("a2")

End Sub


Sub GradientOne(rng As Range)
    ApplyGradient rng, Array(0, 0.04, 0.09, 0.15, 1), _
                 Array(RGB(253, 200, 25), RGB(255, 192, 0), _
                       RGB(143, 207, 80), RGB(143, 207, 80), RGB(0, 176, 80))
End Sub

Sub GradientTwo(rng As Range)
    ApplyGradient rng, Array(0, 0.5, 1), _
                 Array(RGB(253, 200, 25), RGB(255, 192, 0), RGB(143, 207, 80))
End Sub

'apply gradient to rng, using stops in arrStops and colors in arrColors
Sub ApplyGradient(rng As Range, arrStops, arrColors)
    Dim i As Long
    With rng.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 180
        .Gradient.ColorStops.Clear
        For i = LBound(arrStops) To UBound(arrStops)
            With .Gradient.ColorStops.Add(arrStops(i))
                .Color = arrColors(i)
                .TintAndShade = 0
            End With
        Next i
    End With
End Sub

如何简化/使代码更好地包含重复的大小写和with语句？

1 个答案: