VBNet - Форум - Запуск макроса окрашивающего текст и бордюр в смеж

Вопрос: Запуск макроса окрашивающего текст и бордюр в смеж Добавлено: 24.12.08 18:12

Автор вопроса: Григорий

Здравствуйте!
Очень рад находиться на таком замечательном форуме.
как запускать макрос при совпадении рядом в смежных диапазонах( B:C ) одинаковых значений?
Public Sub B_RED_TEXT()
    With Range("B15:C15").Font
    .Bold = True
    .Size = 15
    .Color = -16776961
    End With
With Range("B15:C15").Borders
        .LineStyle = xlNone
        .Weight = xlThick
        .Color = -16776961
    End With

Большое спасибо за внимание, заранее благодарен
Ответить

Ответы Всего ответов: 12

Номер ответа: 1 Автор ответа: Nytrogen Вопросов: 18 Ответов: 186	Профиль \| \| #1	Добавлено: 24.12.08 19:51
	Попробуйте так Option Explicit Public Sub B_RED_TEXT() Dim theRange As Range Dim matchRange As Range Dim Cell As Range 'определяем первую колонку диапазона Set theRange = ThisWorkbook.Worksheets("Sheet1").Range("B1") Set theRange = Range(theRange, theRange.Worksheet.Cells(Rows.Count, theRange.Column).End(xlUp)) 'проходим по ней и ищем совпадения... Application.ScreenUpdating = False For Each Cell In theRange If Cell.Value = Cell.Offset(0, 1).Value Then Set matchRange = Union(Cell, Cell.Offset(0, 1)) Debug.Print matchRange.Address(False, False) With matchRange.Font .Bold = True .Size = 15 .Color = -16776961 End With With matchRange.Borders .LineStyle = xlNone .Weight = xlThick .Color = -16776961 End With End If Next Cell Application.ScreenUpdating = True End Sub Ответить

Номер ответа: 2 Автор ответа: Григорий Вопросов: 21 Ответов: 35	Профиль \| \| #2	Добавлено: 24.12.08 20:26
	Я попробовал - окрашиваются все ячейки диапазона получается такая операция при помощи условного форматирования в EXEL 2007 (если тебе надо программу EXEL 2007 ( у меня на английском языке Интерпрайз )я тебе могу прислать =AND(AND($B1;$C1)<>" ";$B1=$C1) эта формула получается при условном форматировании вот если бы ее попробовать в VBA Ответить

Номер ответа: 3 Автор ответа: Григорий Вопросов: 21 Ответов: 35	Профиль \| \| #3	Добавлено: 24.12.08 20:36
	ошибся - не EXEL 2007 а OFFICE 2007 ENTERRPISE ( я уже обалдел от EXEL поэтому ошибся ) Ответить

Номер ответа: 4 Автор ответа: Nytrogen Вопросов: 18 Ответов: 186	Профиль \| \| #4	Добавлено: 24.12.08 21:04
	Странно, у меня всё работает. Единственное, что не учитываются пустые ячейки. Но это исправимо, исправьте 13ую строку на If Cell.Value <> "" And Cell.Value = Cell.Offset(0, 1).Value Then Ответить

Номер ответа: 5 Автор ответа: Григорий Вопросов: 21 Ответов: 35	Профиль \| \| #5	Добавлено: 24.12.08 21:21
	Да теперь работает при запуске макроса Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Range("B1"), Target) Is Nothing Then Exit Sub If Target.Value = 1 Then Call Макрос2 End Sub а как сделать чтобы автоматичеки макрос запускался при выполнении условия типа Call Макрос2 Ответить

Номер ответа: 6 Автор ответа: Nytrogen Вопросов: 18 Ответов: 186	Профиль \| \| #6	Добавлено: 24.12.08 21:32
	а как сделать чтобы автоматичеки макрос запускался при выполнении условия типа Call Макрос2 А вы типа условие сначала скажите Ответить

Номер ответа: 7 Автор ответа: Григорий Вопросов: 21 Ответов: 35	Профиль \| \| #7	Добавлено: 24.12.08 21:50
	тот макрос для примера ------------------------------ когда ячейки совпадут в смежных диапазонах то запускается на выполнение макрос окрашивающий текст и ячейки который я сначала прислал Ответить

Номер ответа: 8 Автор ответа: Nytrogen Вопросов: 18 Ответов: 186	Профиль \| \| #8	Добавлено: 24.12.08 22:03
	Я ничё не понял . Если Вы имеете в виду процедуру Worksheet_Change, то вероятно так: Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Range("B1"), Target) Is Nothing Then Exit Sub If Target.Value = 1 Then Call B_RED_TEXT End Sub Ответить

Номер ответа: 9 Автор ответа: Григорий Вопросов: 21 Ответов: 35	Профиль \| \| #9	Добавлено: 24.12.08 22:36
	# Option Explicit # # Public Sub B_RED_TEXT() # Dim theRange As Range # Dim matchRange As Range # Dim Cell As Range # 'определяем первую колонку диапазона # Set theRange = ThisWorkbook.Worksheets("Sheet1").Range("B1") # Set theRange = Range(theRange, theRange.Worksheet.Cells(Rows.Count, theRange.Column).End(xlUp)) # 'проходим по ней и ищем совпадения... # Application.ScreenUpdating = False # For Each Cell In theRange If Cell.Value <> "" And Cell.Value = Cell.Offset(0, 1).Value Then # Set matchRange = Union(Cell, Cell.Offset(0, 1)) # Debug.Print matchRange.Address(False, False) # With matchRange.Font # .Bold = True # .Size = 15 # .Color = -16776961 # End With # With matchRange.Borders # .LineStyle = xlNone # .Weight = xlThick # .Color = -16776961 # End With # End If # Next Cell # Application.ScreenUpdating = True # End Sub этот макрос работает при нажатии кнопки , как сделать чтобы он работал автоматически, когда ячейки совпадут в смежных диапазонах то запускается на выполнение макрос окрашивающий текст и ячейки в нем надо сделать изменения после Debug.Print matchRange.Address(False, False) написать вызвать макрос, который занимается художественным оформлением ( окраской ячеек и текста) также у меня вопрос можно ли заменить во всем тексте функции matchRange на значение диапазонов Range("B15:C15". дело в том, что у меня на рабочем листе несколько таких смежных диапазонов и неизвестно как макрос будет в них работать Ответить

Номер ответа: 10 Автор ответа: Григорий Вопросов: 21 Ответов: 35	Профиль \| \| #10	Добавлено: 24.12.08 22:46
	чтобы макрос проверял значения только в конкретных двух диапазонах Ответить

Номер ответа: 11 Автор ответа: Nytrogen Вопросов: 18 Ответов: 186	Профиль \| \| #11	Добавлено: 24.12.08 23:17
	Кхем... Мой макрос проходит по всей колонке B:B и выделяет Вашим способом ячейки, совпадающие в колонке C:C. Выполняйте его как я Вам показал в ответе #8 Ответить

Номер ответа: 12 Автор ответа: Григорий Вопросов: 21 Ответов: 35	Профиль \| \| #12	Добавлено: 24.12.08 23:42
	Хорошо, большое спасибо, завтра попробую на работе Большое спасибо. Cпокойной ночи. Ответить

Страница: 1 |