VBA程序为所有具有值的单元格着色

我刚开始自学自己的VBA，所以提前感谢。 为什么这给我一个错误？ 代码search将来的date列。 然后在该列中search任何有值的单元格，并将它们变为黄色。

谢谢！

Sub Macro1() Dim cell As Range Dim cell2 As Range Dim ColumnN As Long For Each cell In Range("I2:ZZ2") If cell.Value > Now() Then ' ColumnN = cell.Column ColumnL = ConvertToLetter(ColumnN) MsgBox ColumnL & cell.Row For Each cell2 In Range("ColumnL:ColumnL") If Not cell2 Is Empty Then cell2.Interior.ColorIndex = 6 End If Next cell2 End If End Sub() Function ConvertToLetter(lngCol As Long) As String Dim vArr vArr = Split(Cells(1, lngCol).Address(True, False), "$") ConvertToLetter = vArr(0) End Function 

Answer 1

你几乎在那里！ 有两个主要的问题需要解决：

更换：

 For Each cell2 In Range("ColumnL:ColumnL") 

同

 For Each cell2 In Range(ColumnL & ":" & ColumnL) 

和

 If Not cell2 Is Empty Then 

同

 If Not IsEmpty(cell2) Then 

这应该导致以下结果：

 Sub Macro1() Dim cell As Range Dim cell2 As Range Dim ColumnN As Long Dim ColumnL As String For Each cell In Range("I2:ZZ2") If cell.Value > Now() Then ColumnN = cell.Column ColumnL = ConvertToLetter(ColumnN) MsgBox ColumnL & cell.Row For Each cell2 In Range(ColumnL & ":" & ColumnL) If Not IsEmpty(cell2) Then cell2.Interior.ColorIndex = 6 End If Next cell2 End If Next cell End Sub Function ConvertToLetter(lngCol As Long) As String Dim vArr vArr = Split(Cells(1, lngCol).Address(True, False), "$") ConvertToLetter = vArr(0) End Function 

虽然它有点低效，但它完成了工作！

Answer 2

要检查单元格是否为空，您需要切换完成的顺序。 把你的If Not语句切换到If Not IsEmpty(cell2) Then 。

此外，强烈build议不要命名variablescell ，因为这与Excel使用的某些“特殊字词”（我忘了技术术语）很接近。 我总是只使用cel而不是。

 Sub test() Dim cel As Range Dim cel2 As Range Dim ColumnN As Long For Each cel In Range("I2:ZZ2") If cel.Value > Now() Then ColumnN = cel.Column ' ColumnL = ConvertToLetter(ColumnN) ' MsgBox ColumnL & cell.Row If Not IsEmpty(cel) Then cel.Interior.ColorIndex = 6 End If End If Next cel End Sub 

编辑：如果你注意到，我也调整了你的cell2 range 。 这消除了需要运行另一个macros（这可能是有时问题的原因），所以你只需要列号。

Edit2：我删除了“ColumnL”范围select – 这是什么？ 我可以将它添加回来，但不知道为什么你要通过I：ZZ列循环，但只有第N列中的突出显示。

EDIT2：

我调整了代码，现在它更短，运行速度要快一些：

 Sub Macro2() Dim cel As Range, rng As Range Dim lastCol As Long Application.ScreenUpdating = False lastCol = Cells(2, 9).End(xlToRight).Column ' Note, this assumes there are NO gaps in the columns from I:ZZ 'lastCol = cells(2,16384).End(xltoleft).column ' use this instead, if there are gaps in I2:ZZ2 Set rng = Range(Cells(2, 9), Cells(2, lastCol)) For Each cel In rng If cel.Value > Now() Then cel.Interior.ColorIndex = 6 End If Next cel Application.ScreenUpdating = True End Sub