我是VBA的新手（我两天前开始）并获得了实习任务。我制作的程序基于单元格中的单词制作了一个点系统，然后为其分配了颜色。有不同的部分被整行划分，我不想为那一行着色。相反，我制作了五个不同的范围和每个IF语句的副本，但我不确定是否应该制作一个循环或某些东西来跳过那些我不想着色的黑色行。这是我的代码，如果您需要更好地解释我想要解释的内容，请询问。
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
另外，出于好奇，这种语言/经常使用的常见程度如何？
答案 0 :(得分：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，那么这种语言至少对某些人来说会被使用很多。 / p>