Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для перебора ячеек в столбце, Нужна помощь в написании макроса для перебора ячеек в столбце
 
#1
16.06.2017 16:06:07
Добрый день, подскажите пожалуйста макрос что бы перебирал значения в первом столбце, и при соблюдении определенного условия добавлял новую пустую строку и красил ее в другой цвет.
В моем случае когда он натыкается на ячейку с другим значением (если все значения А и следующее B то между ними пустую строку)
Приблизительный алгоритм знаю, но с VBA дружу не сильно и сам написать не могу.
В примере более наглядно видно что нужно получить. Буду очень благодарен.
 
Изменено: evgeniy2507 - 16.06.2017 16:07:43
 
 
 
#2
16.06.2017 16:21:40
Код
Sub qqq()
Dim i&, lstr&
lstr = Cells(Rows.count, 1).End(xlUp).row
For i = 2 To lstr
    If Cells(i, 1) <> Cells(i + 1, 1) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1).Resize(, 3).Interior.Color = RGB(191, 191, 191)
        i = i + 1
    End If
Next
End Sub
Изменено: Владимир - 16.06.2017 16:32:33
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#3
16.06.2017 16:27:29
Владимир, подскажите пожалуйста, функцию что бы меняло цвет
 
 
 
#4
16.06.2017 16:31:39
Владимир, попробовал использовать макрос, выбивает ошибку Application-define or object-defined error
 
 
 
#5
16.06.2017 16:33:27
Поправил код.
См. #2
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#6
16.06.2017 16:36:35
Владимир, отлично, то что нужно, а можно также что бы он в конце таблицы делал 2 серых пустых полосы. При условии что длина таблицы будет меняться
 
 
 
#7
16.06.2017 16:40:48
Добавьте строку после Next:
Код
Cells(i + 2, 1).Resize(2, 3).Interior.Color = RGB(191, 191, 191)
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#8
16.06.2017 17:03:08
Владимир,прошу прощения, позволил себе немного подправить ваш код, думаю этот будет более корректно работать.
Код
Sub qqq()
Dim i&, lstr&
lstr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lstr To 2 Step -1
    If Cells(i, 1) <> Cells(i + 1, 1) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1).Resize(, 3).Interior.Color = RGB(191, 191, 191)
    End If
Next
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#9
16.06.2017 17:10:06
Спасибо всем огромное за помощь!!!
 
 
 
#10
16.06.2017 17:10:38
Да пожалуйста, поправляйте.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
Страницы: 1
Наверх