0

这应该是一个简单的修复，但我是 VBA 世界和一般编程的新手。这是我必须验证包含调查条目值的特定列的代码。一些调查问题的值可能性是相同的，我不想为每个问题复制并粘贴相同的代码，然后更改列字母和数字。我确信有一种简单的方法可以做到这一点。

具体来说，我希望通过列 AC 对 I 列进行验证，以针对下面的案例进行验证。我真的很想让这段代码尽可能简单。非常感谢。

我喜欢我现在使用的方法，但如果需要从头开始重建，那就这样吧。

Sub MyCheck()

Application.ScreenUpdating = False

Dim i As Integer
    For i = 2 To Range("I65536").End(xlUp).Row
        Select Case Cells(i, 9).Value
            Case "1", "2", "3", "4", "5", "88", "99"
                Cells(i, 9).Interior.ColorIndex = xlNone
            Case Else
               Cells(i, 9).Interior.ColorIndex = 6
        End Select
    Next i
    Application.ScreenUpdating = True

End Sub
4

1 回答 1

0

像这样？

Option Explicit

Sub MyCheck()
    Application.ScreenUpdating = False

    Dim i As Long, lRow As Long
    Dim ws As Worksheet
    Dim rng As Range, aCell As Range
    Dim ColLetter As String

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> From Col B to Col AC
        For i = 2 To 29
            ColLetter = Split(.Cells(, i).Address, "$")(1)

            '~~> Find the last row of the releavnt column
            lRow = .Range(ColLetter & .Rows.Count).End(xlUp).Row

            '~~> Set your range
            Set rng = .Range(ColLetter & "2:" & ColLetter & lRow)

            '~~> Remove all the color. Note we are not doing this
            '~~> in the loop
            rng.Interior.ColorIndex = xlNone

            For Each aCell In rng
                Select Case aCell.Value
                Case 1 To 5, 88, 89
                Case Else
                    aCell.Interior.ColorIndex = 6
                End Select
            Next
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

截屏

在此处输入图像描述

于 2013-04-16T16:58:36.553 回答