VBA语法/代码检查

Question

我被要求制作一个Excel宏，根据三个单词来确定点，然后根据点的范围给方框上颜色，这样就可以快速确定可以处理的内容。我是VBA的新手，我读过一些书，到目前为止，这就是我想出来的。我希望有人能让我知道我是否走在正确的轨道上，或者我是否过于复杂化了。

到目前为止，这就是我所拥有的：

Sub Macro_Test()

    Dim TotalScore As Integer

    'Look through H to determine what word is contained and then add 
    'a value to the total score
    'When I try to add to the TotalScore the addition sign goes away 
    '(not sure if the .Value is supposed to be used)
    If (Sheet1.Columns(2, 8) = "Yes") Then
        TotalScore.Value 3
    ElseIf (H17 = "Partial") Then
        TotalScore.Value 2
    ElseIf (H17 = "No") Then
        TotalScore.Value 1

    'The 70th row in column 8(H) is equal/shows the total score
    Sheet1.Columns(70, 8) = TotalScore.Value

    'Color depending on the final score, depending on how line above 
    'works will change to the value in H70
    If (TotalScore < 86 And TotalScore > 69) Then
        'Find proper color for green
        H70.Interior.ColorIndex = 3
    ElseIf (TotalScore < 70 And TotalScore > 44) Then
        'Find proper color for yellow
        H70.Interior.ColorIndex = 2
    ElseIf (TotalScore < 45 And TotalScore > 17) Then
        'Find proper color for red
        H70.Interior.ColorIndex = 1
End Sub

这就是我现在所拥有的：

Sub Macro_Test()

    Dim TotalScore As Integer
    'Set the total score to zero
    TotalScore = 0
    Dim SrchRange As Range
    'Make a range that goes from H1 to H69
    Set SrchRange = Sheet1.Range("H1", "H69")


    'Look through H to determine what word is contained
    'and then add a value to the total score
    For Each FilledCell In SrchRange
        If (FilledCell = "Yes") Then
            TotalScore = TotalScore + 3
        ElseIf (FilledCell = "Partial") Then
            TotalScore = TotalScore + 2
        ElseIf (FilledCell = "No") Then
            TotalScore = TotalScore + 1
        End If
    Next Source


    'Make it so on sheet one the 72th row under column H
    'displays the total score
    Range("H72") = TotalScore

    'Color depending on the final score, depending on how 
    'line above works will change to the value in H72

    If (TotalScore < 86 And TotalScore > 69) Then
        'Find proper color for green
        Range("H70").Interior.ColorIndex = 3
    ElseIf (TotalScore < 70 And TotalScore > 44) Then
        'Find proper color for yellow
        Range("H70").Interior.ColorIndex = 2
    ElseIf (TotalScore < 45 And TotalScore > 17) Then
        'Find proper color for red
        Range("H70").Interior.ColorIndex = 1
    End If

End Sub

我应该双倍缩进我的代码吗？在VBA中，它是缩进的，但在这里，我手动向每一行添加了四个空格。再次抱歉，谢谢你，因为我对这一切都是陌生的。

我对“为每个人”之后的“下一个”部分感到困惑：

    Sub Macro_Test()

        Dim TotalScore As Integer
        'Set the total score to zero
        TotalScore = 0
        Dim SrchRange As Range
        'Make a range that goes from H1 to H69
        Set SrchRange = Sheet1.Range("H2:H69")


        'Look through H to determine what word is contained and then add a value to the total score
        For Each FilledCell In SrchRange
            If (FilledCell = "Yes") Then
                TotalScore = TotalScore + 3
            ElseIf (FilledCell = "Partial") Then
                TotalScore = TotalScore + 2
            ElseIf (FilledCell = "No") Then
                TotalScore = TotalScore + 1
            End If
        Next FilledItem


        'Make it so on sheet one the 72th row under column H displays the total score
        Range("H72") = TotalScore

        'Color depending on the final score, depending on how line above works will change to the value in H70

        If (TotalScore < 86 And TotalScore > 69) Then
            'Find proper color for green
            Range("H70").Interior.Color = 5287936
        ElseIf (TotalScore < 70 And TotalScore > 44) Then
            'Find proper color for yellow
            Range("H70").Interior.Color = 65535
        ElseIf (TotalScore < 45 And TotalScore > 17) Then
            'Find proper color for red
            Range("H70").Interior.Color = 255
        End If

    End Sub

我快完成了。我想使它，当是在H列时，每一列的K是着色的。我会为每一个人做一个单独的，还是有办法把它与我目前的方法？

    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 SrchRange = Sheet1.Range("H20:H69")
        'Dim SrchRange2 As Range
        'Range for the For Each for colors
        'Set SrchRange2 = Sheet1.Range("K20:K69")


        'Look through H to determine what word is contained
        'and then add a value to the total score
        For Each FilledCell In SrchRange
            If (FilledCell = "Yes") Then
                TotalScore = TotalScore + 5
                'I am thinking of putting it in this for each
                'and from there set the R cell of the same row to green
                'so do I make a new range and implement it or what
            ElseIf (FilledCell = "Partial") Then
                TotalScore = TotalScore + 3
            ElseIf (FilledCell = "No") Then
                TotalScore = TotalScore + 1
            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
            'Find proper color for green
            Range("K70").Interior.Color = 5287936
        ElseIf (TotalScore < 70 And TotalScore > 44) Then
            'Find proper color for yellow
            Range("K70").Interior.Color = 65535
        ElseIf (TotalScore < 45 And TotalScore > 17) Then
            'Find proper color for red
            Range("K70").Interior.Color = 255
        End 

    End Sub

我非常感谢所有的帮助！

如果其他人有类似的问题，并且他们希望看到成品:subColor_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 SrchRange = Sheet1.Range("H20:H69")
    'Dim SrchRange2 As Range
    'Range for the For Each for colors
    'Set SrchRange2 = Sheet1.Range("K20:K69")


    'Look through H to determine what word is contained
    'and then add a value to the total score
    For Each FilledCell In SrchRange
        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 = 5287936
        ElseIf (FilledCell = "Partially") Then
            TotalScore = TotalScore + 3
            FilledCell.Offset(0, 3).Interior.Color = 65535
        ElseIf (FilledCell = "No") Then
            TotalScore = TotalScore + 1
            FilledCell.Offset(0, 3).Interior.Color = 255
        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
        'Find proper color for green
        Range("K70").Interior.Color = 5287936
    ElseIf (TotalScore < 70 And TotalScore > 44) Then
        'Find proper color for yellow
        Range("K70").Interior.Color = 65535
    ElseIf (TotalScore < 45 And TotalScore > 17) Then
        'Find proper color for red
        Range("K70").Interior.Color = 255
    End If

End Sub

Answer 1

试试看，我想我明白你要做什么，但你的解释有点含糊

Sub test()

Dim SrchRng As Range
Set SrchRng = ActiveSheet.Range("H2:H69")
Dim TotalScore As Integer
TotalScore = 0

For Each Source In SrchRng
    If Source = "yes" Then
        TotalScore = TotalScore + 3
        Source.Offset(0, 3).Interior.Color = 5287936
    ElseIf Source = "partial" Then
        TotalScore = TotalScore + 2
    ElseIf Source = "no" Then
        TotalScore = TotalScore + 1
    End If
Next Source

If (TotalScore < 86 And TotalScore > 69) Then
        Range("H70").Interior.Color = 5287936
    ElseIf (TotalScore < 70 And TotalScore > 44) Then
        Range("H70").Interior.Color = 65535
    ElseIf (TotalScore < 45 And TotalScore > 17) Then
        Range("H70").Interior.Color = 255
End If

End Sub