Программа VBA для окраски всех ячеек, у которых есть значение

Question

Я только начал преподавать себя VBA, поэтому спасибо заранее. Почему это дает мне ошибку? Код ищет столбец дат, который будет в будущем. Затем выполняет поиск в этом столбце для любых ячеек, которые имеют значение и окрашивают их в желтый цвет.

Спасибо!

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.

Кроме того, не рекомендуется указывать ваши переменные cell, потому что это близко к некоторым «специальным словам» (я забыл технический термин), который использует 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 

Edit: Если вы заметили, я тоже подправили свой cell2range. Это устранило необходимость запуска другого макроса (иногда это может быть причиной проблем), поэтому вам нужен только столбец Number.

Edit2: Я удалил диапазон диапазона «ColumnL» - что это такое? Я могу добавить его обратно, но не был уверен, почему вы хотите перебрать 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