Приветствую парни. Будьте добры, помогите реализовать данную задачу. Есть диапазон ячеек А1:А100 – ALP1:ALP100, то есть 999столцов и 100строк, вообще строк может быть и 200 и 300 тд. В каждой ячейке для своего столбца есть одно значение из четырех возможных: (+) (-) (=) (0) В каждом столбце нужно произвести просмотр с низу в верх или наоборот главное что бы просмотр был по столбцам, найти ячейки в которых есть одинаковые последовательные значения например значения плюса: если значений (+) 5-ть, то выделить их в желтый цвет; если значений (+) 6-ть, то выделить их в зеленый цвет; если значений (+) 7-мь, выделить их в оранжевый цвет; если значений (+) 8-мь, то выделить их в красный цвет; если значений (+) 9-ть и более, выделить в синий цвет. Пробовал все это сделать условным форматированием, не получается! Заранее спасибо за помощь. В примере кусок диапазона с выделенными значениями в ручную.
Приветствую парни. Будьте добры, помогите реализовать данную задачу. Есть диапазон ячеек А1:А100 – ALP1:ALP100, то есть 999столцов и 100строк, вообще строк может быть и 200 и 300 тд. В каждой ячейке для своего столбца есть одно значение из четырех возможных: (+) (-) (=) (0) В каждом столбце нужно произвести просмотр с низу в верх или наоборот главное что бы просмотр был по столбцам, найти ячейки в которых есть одинаковые последовательные значения например значения плюса: если значений (+) 5-ть, то выделить их в желтый цвет; если значений (+) 6-ть, то выделить их в зеленый цвет; если значений (+) 7-мь, выделить их в оранжевый цвет; если значений (+) 8-мь, то выделить их в красный цвет; если значений (+) 9-ть и более, выделить в синий цвет. Пробовал все это сделать условным форматированием, не получается! Заранее спасибо за помощь. В примере кусок диапазона с выделенными значениями в ручную.wetri
Sub colorizer() Dim x Dim r&, c& Dim lC&, lR& Dim cRange As Range lC = [A1].End(xlToRight).Column lR = [A1].End(xlDown).Row
x = [A1].Resize(lR, lC).Value
For c = 1 To lC Set cRange = Nothing For r = 1 To lR If r - 1 <> 0 Then If x(r, c) = x(r - 1, c) Then If cRange Is Nothing Then Set cRange = Cells(r, c) Else Set cRange = Union(Cells(r, c), cRange) End If Else Set cRange = Nothing End If End If If r + 1 <= UBound(x) Then If x(r, c) = x(r + 1, c) Then If cRange Is Nothing Then Set cRange = Cells(r, c) Else Set cRange = Union(Cells(r, c), cRange) End If End If End If If Not cRange Is Nothing Then Select Case cRange.Count Case 5 cRange.Interior.Color = vbYellow Case 6 cRange.Interior.Color = vbGreen Case 7 cRange.Interior.Color = vbRed Case 8 cRange.Interior.Color = vbBlue Case 9 cRange.Interior.Color = RGB(100, 100, 100) End Select End If Next Next Set cRange = Nothing End Sub
[/vba]
Так?
[vba]
Код
Sub colorizer() Dim x Dim r&, c& Dim lC&, lR& Dim cRange As Range lC = [A1].End(xlToRight).Column lR = [A1].End(xlDown).Row
x = [A1].Resize(lR, lC).Value
For c = 1 To lC Set cRange = Nothing For r = 1 To lR If r - 1 <> 0 Then If x(r, c) = x(r - 1, c) Then If cRange Is Nothing Then Set cRange = Cells(r, c) Else Set cRange = Union(Cells(r, c), cRange) End If Else Set cRange = Nothing End If End If If r + 1 <= UBound(x) Then If x(r, c) = x(r + 1, c) Then If cRange Is Nothing Then Set cRange = Cells(r, c) Else Set cRange = Union(Cells(r, c), cRange) End If End If End If If Not cRange Is Nothing Then Select Case cRange.Count Case 5 cRange.Interior.Color = vbYellow Case 6 cRange.Interior.Color = vbGreen Case 7 cRange.Interior.Color = vbRed Case 8 cRange.Interior.Color = vbBlue Case 9 cRange.Interior.Color = RGB(100, 100, 100) End Select End If Next Next Set cRange = Nothing End Sub
Sub t() Dim r As Object, m As Object, c As Range, s$, xColor&, a a = Array(vbYellow, vbGreen, vbMagenta, vbRed, vbBlue) Set r = CreateObject("vbscript.regexp") r.Global = True: r.Pattern = "\+{5,}" For Each c In [a1].CurrentRegion.Columns s = Join(Application.Transpose(c), ""): Set m = r.Execute(s) If m.Count Then For i = 0 To m.Count - 1 If m(i).Length >= 9 Then xColor = vbBlue Else xColor = a(m(i).Length - 5) c.Cells(m(i).FirstIndex + 1).Resize(m(i).Length).Interior.Color = xColor Next End If Next End Sub
[/vba]
эх, опередили ну, всё равно - вариант: [vba]
Код
Sub t() Dim r As Object, m As Object, c As Range, s$, xColor&, a a = Array(vbYellow, vbGreen, vbMagenta, vbRed, vbBlue) Set r = CreateObject("vbscript.regexp") r.Global = True: r.Pattern = "\+{5,}" For Each c In [a1].CurrentRegion.Columns s = Join(Application.Transpose(c), ""): Set m = r.Execute(s) If m.Count Then For i = 0 To m.Count - 1 If m(i).Length >= 9 Then xColor = vbBlue Else xColor = a(m(i).Length - 5) c.Cells(m(i).FirstIndex + 1).Resize(m(i).Length).Interior.Color = xColor Next End If Next End Sub
Спасибо за помощь. Немного не так, нужно твердо указать какое значение выделять, как я понимаю сейчас выделяется любое последовательное значение а нужно именно только (+) ? Нужно, что бы я сам менял значение нужного мне значения в макросе. В примере видно, что в столбце AW есть выделение, но из за того что там и + и - по шесть штук то он весь окрасился в зеленый - это неправильно. А так в логике все правильно.
Спасибо за помощь. Немного не так, нужно твердо указать какое значение выделять, как я понимаю сейчас выделяется любое последовательное значение а нужно именно только (+) ? Нужно, что бы я сам менял значение нужного мне значения в макросе. В примере видно, что в столбце AW есть выделение, но из за того что там и + и - по шесть штук то он весь окрасился в зеленый - это неправильно. А так в логике все правильно.wetri
Вопрос о мелкой модернизации макроса... Оба решения работают. Макрос от SkyPro - гибче, в силу того, что можно в форме менять значения искомых символов. Можно ли в форме "выбора символов" сделать так, что бы возможно было выбирать несколько символов одновременно, например (=) и (-)? В макросе от ikki - переменная object содержит r.Pattern = "\+{5,}" Тот же вопрос как объединить два символа для поиска (=) и (-)? То есть эти два символа как бы объединить в один, сохраняя все прежние условия для выделения.
Вопрос о мелкой модернизации макроса... Оба решения работают. Макрос от SkyPro - гибче, в силу того, что можно в форме менять значения искомых символов. Можно ли в форме "выбора символов" сделать так, что бы возможно было выбирать несколько символов одновременно, например (=) и (-)? В макросе от ikki - переменная object содержит r.Pattern = "\+{5,}" Тот же вопрос как объединить два символа для поиска (=) и (-)? То есть эти два символа как бы объединить в один, сохраняя все прежние условия для выделения. wetri
я вот не понял новых условий интересует вариант с одним и тем же символом? или разными из допустимого списка? т.е. последовательность "-++-+" - это нужная последоваельность из 5 символов? или только "-----" и "+++++" по отдельности?
я вот не понял новых условий интересует вариант с одним и тем же символом? или разными из допустимого списка? т.е. последовательность "-++-+" - это нужная последоваельность из 5 символов? или только "-----" и "+++++" по отдельности?ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
Условия такие - в примере test.xlsx, столбец СМ, начинать просмотр нужно снизу, там идут (= - = - 0) их нужно покрасить в желтый, так как эта цепочка(список) состоит из 5 символов. Знак (+) - он отдельный символ от остальных, смешивать с остальными его нельзя и красить его не нужно! Еще пример: столбец "O" 23 строка, опять просмотр снизу (= - 0 - - -) эту цепочку нужно покрасить в зеленый и тд. Если встречаются символы в любой последовательности (= - 0) то считать их как за один. Символ (+) красить не нужно, я же для плюса могу использовать старый макрос. Если возможно, в одном макросе сделать выбор нужных символов для выделения из списка, то это вообще будет СУПЕР! Уфф, надеюсь Вы мою логику поймете..
Условия такие - в примере test.xlsx, столбец СМ, начинать просмотр нужно снизу, там идут (= - = - 0) их нужно покрасить в желтый, так как эта цепочка(список) состоит из 5 символов. Знак (+) - он отдельный символ от остальных, смешивать с остальными его нельзя и красить его не нужно! Еще пример: столбец "O" 23 строка, опять просмотр снизу (= - 0 - - -) эту цепочку нужно покрасить в зеленый и тд. Если встречаются символы в любой последовательности (= - 0) то считать их как за один. Символ (+) красить не нужно, я же для плюса могу использовать старый макрос. Если возможно, в одном макросе сделать выбор нужных символов для выделения из списка, то это вообще будет СУПЕР! Уфф, надеюсь Вы мою логику поймете.. wetri
Сообщение отредактировал wetri - Воскресенье, 06.04.2014, 21:22
ну, если правильно понял - в моём коде надо использовать другой шаблон: [vba]
Код
r.Pattern = "[-=0]{5,}"
[/vba]всё остальное то же самое.
пс. если нужно использовать другой перечень символов, принимаемых "за один", просто измените шаблон, указав эти символы внутри квадратных скобок. важно! если среди этих символов будет "-", его нужно указывать либо первым (как в моём примере), либо последним, иначе он будет иметь другой смысл. кроме того, есть ещё оговорки насчёт символа "^", но, надеюсь, он у вас не встретится
ну, если правильно понял - в моём коде надо использовать другой шаблон: [vba]
Код
r.Pattern = "[-=0]{5,}"
[/vba]всё остальное то же самое.
пс. если нужно использовать другой перечень символов, принимаемых "за один", просто измените шаблон, указав эти символы внутри квадратных скобок. важно! если среди этих символов будет "-", его нужно указывать либо первым (как в моём примере), либо последним, иначе он будет иметь другой смысл. кроме того, есть ещё оговорки насчёт символа "^", но, надеюсь, он у вас не встретится ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
Сообщение отредактировал ikki - Воскресенье, 06.04.2014, 22:50
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
