Прошу поправить макрос, форматирующий ячейки при невыполнении условия.

Пользователь

Сообщений: 78 Регистрация: 01.01.1970

26.08.2010 00:16:03

Добрый день!
Сразу прошу прощения у гуру - учусь я... :(
Написал макрос, перебирающий даты в столбце и рисующий границу над диапазоном ячеек, если дата не совпадает с датой в вышестоящей ячейке. Вроде бы работает, но не могу понять почему он также рисует границу в ячейке, которая при запуске макроса являлась активной? Как можно этого избежать?

Sub Border()
Application.ScreenUpdating = False
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = iLastRow To 2 Step -1
If ActiveWorkbook.Worksheets("Приложение 2").Cells(i, 1) <> Cells(i - 1, 1) Then Range(Cells(i, 1), Cells(i, 12)).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
Next
End Sub

И второе... если не затруднит - прошу подсказать как добавить дополнительное форматирование, если условие выполняется, т.е.:
If ActiveWorkbook.Worksheets("Приложение 2").Cells(i, 1) = Cells(i - 1, 1) Then Range(Cells(i, 1), Cells(i, 12)).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlHairline
End With

Прощу не ругать сильно.
Пример - 49 Кб.

Прикрепленные файлы

post_149440.xls (49 КБ)

Hugo

Пользователь

Сообщений: 26326 Регистрация: 22.12.2012

26.08.2010 00:30:57

1. А до выполнения
If ActiveWorkbook.Worksheets("Приложение 2").Cells(i, 1) <> Cells(i - 1, 1) Then Range(Cells(i, 1), Cells(i, 12)).Select
где надо (и надо ли) рисовать рамку?

Т.е. рамка рисуется на каждом ходе цикла в активной ячейке.

2. и можно сказать исправить 1.:
If ActiveWorkbook.Worksheets("Приложение 2").Cells(i, 1) <> Cells(i - 1, 1) Then
Range(Cells(i, 1), Cells(i, 12)).Select
With Selection раз
end with
With Selection два
end with

А вообще лучше без Select и Selection:

Option Explicit

Sub Border()
Application.ScreenUpdating = False
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = iLastRow To 2 Step -1
If ActiveWorkbook.Worksheets("Приложение 2").Cells(i, 1) <> Cells(i - 1, 1) Then
With Range(Cells(i, 1), Cells(i, 12)).Borders(xlEdgeTop) 'первый формат
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With

With Range(Cells(i, 10), Cells(i, 120)).Borders(xlEdgeTop) 'второй формат
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With

End If
Next
End Sub

Hugo Пользователь Сообщений: 26326 Регистрация: 22.12.2012	#3 26.08.2010 00:33:12 Если бы Вы прогнали первый код пошагово по Ф8, сразу бы увидели, почему рамка не там.

Юрий М

Модератор

Сообщений: 61089 Регистрация: 14.09.2012

Контакты см. в профиле

26.08.2010 00:33:40

{quote}{login=Palex}{date=26.08.2010 12:16}{thema=Прошу поправить макрос, форматирующий ячейки при невыполнении условия.}{post}почему он также рисует границу в ячейке, которая при запуске макроса являлась активной?{/post}{/quote}
Добрый вечер!
Потому что Вы сами об этом макрос попросили. Вот в этой строке:
With Selection
Какая ячейка была активной, та и "Selection" :-)
Попробуйте так:
Sub Border()
Application.ScreenUpdating = False
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = iLastRow To 2 Step -1
If ActiveWorkbook.Worksheets("Приложение 2").Cells(i, 1) <> Cells(i - 1, 1) Then
With Range(Cells(i, 1), Cells(i, 12)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
End If
Next
End Sub

Palex

Пользователь

Сообщений: 78 Регистрация: 01.01.1970

26.08.2010 08:37:50

Спасибо вам ребят, за подсказку - понял, в чем была моя ошибка.
А по второй части вопроса - подскажите все же пожалуйста - как вписать другое форматирование в случае, если условие
If ActiveWorkbook.Worksheets("Приложение 2").Cells(i, 1) <> Cells(i - 1, 1)
не выполняется?

Hugo Пользователь Сообщений: 26326 Регистрация: 22.12.2012	#6 26.08.2010 09:04:51 Palex если не выполняется - Else If...Then ... Else ... End If Тож азы!

Palex Пользователь Сообщений: 78 Регистрация: 01.01.1970	#7 26.08.2010 09:13:51 Hugo, да я знаю, что азы... как раз на них пока и остановился... вернее пытаюсь с них сдвинуться. :) СПАСИБО! Все получилось!

Читают тему