Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Закрасить таблицу по условию. (Не условное форматирование.) - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Закрасить таблицу по условию. (Не условное форматирование.) (Макросы/Sub)
Закрасить таблицу по условию. (Не условное форматирование.)
Aleksej Дата: Воскресенье, 03.04.2016, 18:55 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Всем доброго времени суток! :)

В очередной раз нужна помощь экселистов. :)

Суть проблемы.
1. Имеется 2 таблицы "А" и "Б" - идентичные по размеру, на разных листах (количество строк меняется)
2. Макросом проверяем таблицу "А" и если в какой-то ячейке есть слово "Ошибка", то в таблице "Б" закрасить соответствующую ячейку.
3. !!! Условное форматирование не предлагать. Нужен именно макрос.
4. Файл примера в приложении.
К сообщению приложен файл: 1359.xlsm(14Kb)
 
Ответить
СообщениеВсем доброго времени суток! :)

В очередной раз нужна помощь экселистов. :)

Суть проблемы.
1. Имеется 2 таблицы "А" и "Б" - идентичные по размеру, на разных листах (количество строк меняется)
2. Макросом проверяем таблицу "А" и если в какой-то ячейке есть слово "Ошибка", то в таблице "Б" закрасить соответствующую ячейку.
3. !!! Условное форматирование не предлагать. Нужен именно макрос.
4. Файл примера в приложении.

Автор - Aleksej
Дата добавления - 03.04.2016 в 18:55
KuklP Дата: Воскресенье, 03.04.2016, 19:03 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

В точности для примера :D
[vba]
Код
Public Sub www()
    On Error Resume Next
    Sheets("Лист2").Range([Лист1!a9:x25].SpecialCells(2).Address).Interior.ColorIndex = 4
End Sub
[/vba]


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Понедельник, 04.04.2016, 00:11
 
Ответить
СообщениеВ точности для примера :D
[vba]
Код
Public Sub www()
    On Error Resume Next
    Sheets("Лист2").Range([Лист1!a9:x25].SpecialCells(2).Address).Interior.ColorIndex = 4
End Sub
[/vba]

Автор - KuklP
Дата добавления - 03.04.2016 в 19:03
Aleksej Дата: Воскресенье, 03.04.2016, 19:09 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
KuklP, Здравствуйте! :) В очередной раз спасибо за Ваши краткие и содержательные коды.
Для общего развития то что надо. yes
 
Ответить
СообщениеKuklP, Здравствуйте! :) В очередной раз спасибо за Ваши краткие и содержательные коды.
Для общего развития то что надо. yes

Автор - Aleksej
Дата добавления - 03.04.2016 в 19:09
StoTisteg Дата: Воскресенье, 03.04.2016, 19:14 | Сообщение № 4
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Например, так.
[vba]
Код
Sub Закрасить()

    Dim cl As Range
    
    For Each cl In Worksheets(1).UsedRange
        If cl.Value = "Ошибка" Then
            With Worksheets(2)
                .Cells(cl.Row, cl.Column).Interior.Color = vbRed
            End With
        End If
    Next cl

End Sub
[/vba]


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеНапример, так.
[vba]
Код
Sub Закрасить()

    Dim cl As Range
    
    For Each cl In Worksheets(1).UsedRange
        If cl.Value = "Ошибка" Then
            With Worksheets(2)
                .Cells(cl.Row, cl.Column).Interior.Color = vbRed
            End With
        End If
    Next cl

End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 03.04.2016 в 19:14
Aleksej Дата: Воскресенье, 03.04.2016, 19:19 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
StoTisteg, Спасибо! :)
 
Ответить
СообщениеStoTisteg, Спасибо! :)

Автор - Aleksej
Дата добавления - 03.04.2016 в 19:19
Udik Дата: Воскресенье, 03.04.2016, 19:32 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1219
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Ну и мой до кучи :) .
[vba]
Код

Public Sub test()
    Dim rng1 As Range, unoCell As Range
    
    Set rng1 = Worksheets("Лист1").Range("A9:X25")
    With Worksheets("Лист2")
        For Each unoCell In rng1
            If unoCell = "Ошибка" Then .Cells(unoCell.Row, unoCell.Column).Interior.Color = VBA.RGB(0, 255, 0)
        Next
        
    End With
End Sub
[/vba]


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Воскресенье, 03.04.2016, 19:33
 
Ответить
СообщениеНу и мой до кучи :) .
[vba]
Код

Public Sub test()
    Dim rng1 As Range, unoCell As Range
    
    Set rng1 = Worksheets("Лист1").Range("A9:X25")
    With Worksheets("Лист2")
        For Each unoCell In rng1
            If unoCell = "Ошибка" Then .Cells(unoCell.Row, unoCell.Column).Interior.Color = VBA.RGB(0, 255, 0)
        Next
        
    End With
End Sub
[/vba]

Автор - Udik
Дата добавления - 03.04.2016 в 19:32
KuklP Дата: Понедельник, 04.04.2016, 00:16 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

With Worksheets(2)
.Cells(cl.Row, cl.Column).Interior.Color = vbRed
End With

StoTisteg, тут конструкция with не нужна, так :
[vba]
Код
Worksheets(2).Cells(cl.Row, cl.Column).Interior.Color = vbRed
[/vba]короче и понятней. :) и с
For Each cl In Worksheets(1).UsedRange я бы поосторожней. Часто не знаешь, до чего оно приведет. Попробуйте свой макрос в приложенном файле, он в модуле листа.
К сообщению приложен файл: -1359-1.xlsm(22Kb)


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Понедельник, 04.04.2016, 00:28
 
Ответить
Сообщение
With Worksheets(2)
.Cells(cl.Row, cl.Column).Interior.Color = vbRed
End With

StoTisteg, тут конструкция with не нужна, так :
[vba]
Код
Worksheets(2).Cells(cl.Row, cl.Column).Interior.Color = vbRed
[/vba]короче и понятней. :) и с
For Each cl In Worksheets(1).UsedRange я бы поосторожней. Часто не знаешь, до чего оно приведет. Попробуйте свой макрос в приложенном файле, он в модуле листа.

Автор - KuklP
Дата добавления - 04.04.2016 в 00:16
Aleksej Дата: Понедельник, 04.04.2016, 23:01 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
KuklP,
Цитата
В точности для примера

Ваш код, отмечает все заполненные ячейки, а надо только где "Ошибка".

Цитата
UsedRange я бы поосторожней

точно, когда большой диапазон ячеек, файл вешает.
 
Ответить
СообщениеKuklP,
Цитата
В точности для примера

Ваш код, отмечает все заполненные ячейки, а надо только где "Ошибка".

Цитата
UsedRange я бы поосторожней

точно, когда большой диапазон ячеек, файл вешает.

Автор - Aleksej
Дата добавления - 04.04.2016 в 23:01
KuklP Дата: Понедельник, 04.04.2016, 23:12 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

Ваш код, отмечает все заполненные ячейки, а надо только где "Ошибка"

Так я и писал "для примера", а в примере все заполненные с "ошибка". :D


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение
Ваш код, отмечает все заполненные ячейки, а надо только где "Ошибка"

Так я и писал "для примера", а в примере все заполненные с "ошибка". :D

Автор - KuklP
Дата добавления - 04.04.2016 в 23:12
Aleksej Дата: Понедельник, 04.04.2016, 23:53 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
KuklP,
Цитата
в примере все заполненные с "ошибка"

ну так то да :)

Я не для себя написал, может кто захочет воспользоваться, чтоб знали, чего ожидать.

Фильтр сам добавил, используя все рекомендации, из 3-х примеров один сделал. :)


Сообщение отредактировал Aleksej - Вторник, 05.04.2016, 00:33
 
Ответить
СообщениеKuklP,
Цитата
в примере все заполненные с "ошибка"

ну так то да :)

Я не для себя написал, может кто захочет воспользоваться, чтоб знали, чего ожидать.

Фильтр сам добавил, используя все рекомендации, из 3-х примеров один сделал. :)

Автор - Aleksej
Дата добавления - 04.04.2016 в 23:53
KuklP Дата: Вторник, 05.04.2016, 03:54 | Сообщение № 11
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

В каждой шутке есть доля шутки. Если ошибки в ячейках - результат работы формул, то достаточно заменить
.SpecialCells(2)
на
.SpecialCells(-4123, 16)
и все сработает как надо.


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеВ каждой шутке есть доля шутки. Если ошибки в ячейках - результат работы формул, то достаточно заменить
.SpecialCells(2)
на
.SpecialCells(-4123, 16)
и все сработает как надо.

Автор - KuklP
Дата добавления - 05.04.2016 в 03:54
Aleksej Дата: Вторник, 05.04.2016, 10:07 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
KuklP,
Цитата
.SpecialCells(-4123, 16) и все сработает как надо.

Удобно. Главное кратко. :)

Все ошибки отмечает, кроме ошибки "Слишком большая или отрицательная дата" (это когда бесконечные решетки рисует - ##########)
Я уже как то, спрашивал на форуме как - эту ошибку отловить.
Может есть код SpecialCells для этой ошибки? Или это за ошибку не считается?
Тот же файл примера - ошибка на Листе1, ячейке F10
К сообщению приложен файл: 4952233.xlsm(21Kb)


Сообщение отредактировал Aleksej - Вторник, 05.04.2016, 12:58
 
Ответить
СообщениеKuklP,
Цитата
.SpecialCells(-4123, 16) и все сработает как надо.

Удобно. Главное кратко. :)

Все ошибки отмечает, кроме ошибки "Слишком большая или отрицательная дата" (это когда бесконечные решетки рисует - ##########)
Я уже как то, спрашивал на форуме как - эту ошибку отловить.
Может есть код SpecialCells для этой ошибки? Или это за ошибку не считается?
Тот же файл примера - ошибка на Листе1, ячейке F10

Автор - Aleksej
Дата добавления - 05.04.2016 в 10:07
_Boroda_ Дата: Вторник, 05.04.2016, 11:02 | Сообщение № 13
Группа: Модераторы
Ранг: Экселист
Сообщений: 9381
Репутация: 3951 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
В той теме мы как раз Вас убеждали, что это не ошибка, а такое отображение данных. В частности, также показывает не только даты, но и, например, большие числа, которые просто не влезают с ширину ячейки (посмотрите желтую ячейку).
К сообщению приложен файл: 4952233_1.xlsm(21Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВ той теме мы как раз Вас убеждали, что это не ошибка, а такое отображение данных. В частности, также показывает не только даты, но и, например, большие числа, которые просто не влезают с ширину ячейки (посмотрите желтую ячейку).

Автор - _Boroda_
Дата добавления - 05.04.2016 в 11:02
Aleksej Дата: Вторник, 05.04.2016, 12:53 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
_Boroda_,
Цитата
мы как раз Вас убеждали, что это не ошибка, а такое отображение данных

Да, я помню, спасибо. Видимо так оно и есть. Потому что как ошибка это не инициализируется. :)


Сообщение отредактировал Aleksej - Вторник, 05.04.2016, 12:59
 
Ответить
Сообщение_Boroda_,
Цитата
мы как раз Вас убеждали, что это не ошибка, а такое отображение данных

Да, я помню, спасибо. Видимо так оно и есть. Потому что как ошибка это не инициализируется. :)

Автор - Aleksej
Дата добавления - 05.04.2016 в 12:53
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Закрасить таблицу по условию. (Не условное форматирование.) (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!