这应该是一个简单的修复,但我是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
答案 0 :(得分:1)
喜欢这个吗?
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
<强>截图强>