减less代码冗余VBA（具体示例代码）

我对VBA非常陌生（我两天前开始），并且获得了一个实习任务。 我做的程序已经根据单元格中的单词做出了一个点系统，然后为它分配颜色。 有一整行分隔的不同部分，我不想为该行着色。 相反，我做了五个不同的范围和每个IF语句的副本，但是我不确定是否应该创build循环或跳过那些我不想着色的黑色行。 这里是我的代码，如果你需要更好的解释我想解释什么，只是问。

Sub Color_Macro() Dim TotalScore As Integer 'Set the total score to zero TotalScore = 0 Dim SrchRange As Range 'Make a range that goes from H20 to H69 Set SrchRange1 = Sheet1.Range("H20:H24") Dim SrchRange2 As Range Set SrchRange2 = Sheet1.Range("H30:H37") Dim SrchRange3 As Range Set SrchRange3 = Sheet1.Range("H42:H49") Dim SrchRange4 As Range Set SrchRange4 = Sheet1.Range("H54:H59") Dim SrchRange5 As Range Set SrchRange5 = Sheet1.Range("H64:H72") 'Look through H to determine what word is contained 'and then add a value to the total score For Each FilledCell In SrchRange1 If (FilledCell = "Yes") Then TotalScore = TotalScore + 5 'Offset it to go three to the 'right and fill in a color FilledCell.Offset(0, 3).Interior.Color = RGB(146, 208, 80) ElseIf (FilledCell = "Partially") Then TotalScore = TotalScore + 3 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0) ElseIf (FilledCell = "No") Then TotalScore = TotalScore + 1 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0) ElseIf (FilledCell = "") Then FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225) End If Next FilledCell For Each FilledCell In SrchRange2 If (FilledCell = "Yes") Then TotalScore = TotalScore + 5 'Offset it to go three to the 'right and fill in a color FilledCell.Offset(0, 3).Interior.Color = RGB(146, 208, 80) ElseIf (FilledCell = "Partially") Then TotalScore = TotalScore + 3 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0) ElseIf (FilledCell = "No") Then TotalScore = TotalScore + 1 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0) ElseIf (FilledCell = "") Then FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225) End If Next FilledCell For Each FilledCell In SrchRange3 If (FilledCell = "Yes") Then TotalScore = TotalScore + 5 'Offset it to go three to the 'right and fill in a color FilledCell.Offset(0, 3).Interior.Color = RGB(146, 208, 80) ElseIf (FilledCell = "Partially") Then TotalScore = TotalScore + 3 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0) ElseIf (FilledCell = "No") Then TotalScore = TotalScore + 1 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0) ElseIf (FilledCell = "") Then FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225) End If Next FilledCell For Each FilledCell In SrchRange4 If (FilledCell = "Yes") Then TotalScore = TotalScore + 5 'Offset it to go three to the 'right and fill in a color FilledCell.Offset(0, 3).Interior.Color = RGB(146, 208, 80) ElseIf (FilledCell = "Partially") Then TotalScore = TotalScore + 3 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0) ElseIf (FilledCell = "No") Then TotalScore = TotalScore + 1 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0) ElseIf (FilledCell = "") Then FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225) End If Next FilledCell For Each FilledCell In SrchRange5 If (FilledCell = "Yes") Then TotalScore = TotalScore + 5 'Offset it to go three to the 'right and fill in a color FilledCell.Offset(0, 3).Interior.Color = RGB(146, 208, 80) ElseIf (FilledCell = "Partially") Then TotalScore = TotalScore + 3 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0) ElseIf (FilledCell = "No") Then TotalScore = TotalScore + 1 FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0) ElseIf (FilledCell = "") Then FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225) End If Next FilledCell 'Make it so on sheet one the 70th row under 'column H displays the total score Range("H70") = TotalScore If (TotalScore < 86 And TotalScore > 69) Then Range("K70").Interior.Color = RGB(146, 208, 80) ElseIf (TotalScore < 70 And TotalScore > 44) Then Range("K70").Interior.Color = RGB(255, 255, 0) ElseIf (TotalScore < 45 And TotalScore > 17) Then Range("K70").Interior.Color = RGB(255, 0, 0) ElseIf (TotalScore < 17) Then Range("K70").Interior.Color = RGB(238, 236, 225) End If End Sub 

而且，出于好奇，这种语言常用于多less？

Answer 1

尝试这个：

 Sub ColorMacro() Dim TotalScore As Long, sr As Range, c As Range Dim fr1 As Range, fr2 As Range, fr3 As Range, fr4 As Range Dim emptyrow As Boolean Set sr = ThisWorkbook.Sheets("Sheet1").Range("H20:H72") For Each c In sr emptyrow = IIf(Application.WorksheetFunction.CountA(c.EntireRow) = 0, _ True, False) Select Case True Case UCase(c.Value) = "YES" TotalScore = TotalScore + 5 If fr1 Is Nothing Then Set fr1 = c.Offset(0, 3) _ Else Set fr1 = Union(fr1, c.Offset(0, 3)) Case UCase(c.Value) = "PARTIALLY" TotalScore = TotalScore + 3 If fr2 Is Nothing Then Set fr2 = c.Offset(0, 3) _ Else Set fr2 = Union(fr2, c.Offset(0, 3)) Case UCase(c.Value) = "NO" TotalScore = TotalScore + 1 If fr3 Is Nothing Then Set fr3 = c.Offset(0, 3) _ Else Set fr3 = Union(fr3, c.Offset(0, 3)) Case c.Value = "" And Not emptyrow If fr4 Is Nothing Then Set fr4 = c.Offset(0, 3) _ Else Set fr4 = Union(fr4, c.Offset(0, 3)) End Select Next If Not fr1 Is Nothing Then fr1.Interior.Color = RGB(146, 208, 80) If Not fr2 Is Nothing Then fr2.Interior.Color = RGB(255, 255, 0) If Not fr3 Is Nothing Then fr3.Interior.Color = RGB(255, 0, 0) If Not fr4 Is Nothing Then fr4.Interior.Color = RGB(238, 236, 225) End Sub 

您可以使用其余的代码将TotalScore的值分配给任何范围。
以及在多种情况下都可以用Select Case Clause替代的条件。 如下所示：

  Select Case True Case TotalScore < 86 And TotalScore > 69 Sheet1.Range("K70").Interior.Color = RGB(146, 208, 80) Case TotalScore < 70 And TotalScore > 44 Sheet1.Range("K70").Interior.Color = RGB(255, 255, 0) Case TotalScore < 45 And TotalScore > 17 Sheet1.Range("K70").Interior.Color = RGB(255, 0, 0) Case TotalScore < 17 Sheet1.Range("K70").Interior.Color = RGB(238, 236, 225) End Select 

请注意，我只是明确的范围对象 （包括sheetname或sheetcodename）。
我希望它不以任何方式混淆你。 如果您有任何疑问，只需发表评论。
至于你使用这种语言的频率有多高，那要看你是什么领域的。
但是，只要你使用的是Microsoft Office，那么这种语言至less有一些用处。