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

Question

我已经拼凑了一个代码来创建自动热图。除非我找到一些快捷方式，否则代码最终将有几千行长。如果有人有耐心解释如何以新手级别的术语简化此操作的步骤，那就太神奇了。一个例子是理想的，我和那些人合作得很好。

我被告知要为每个案例创建一个单独的例程，只用该案例的代码，然后将受影响的范围作为参数传递给每个"子"。我不知道那是什么样子的，所以当我自己尝试时并不顺利。下面的代码只是单元格 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