Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » olegvix
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Сортировка строк по цвету по определенному условию
 
#
30.08.2017 20:45:42
Добрый вечер всем !

Сделал макрос который сортирует в определенной последовательности по цвету
в диапазоне автофильтра.
По кнопке макрос работает как надо.
Вопрос:  как сделать так чтобы при закрашивании строки в диапазоне автофильтра макрос срабатывал по условию -
если только полная строка (не ячейка) в диапазоне автофильтра закрашена одним из трех цветов - то срабатывает макрос  
и остается выделенной строка которую закрасили изначально (при смещении закрашенной строки вверх) ?
и макрос трехэтажный получился рекодером ...
Код
Sub Сортировка_несколько_цветов()
Application.ScreenUpdating = False
    'нет заливки
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "E4:E100"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'коричневый
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add(Range( _
        "E4:E100"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
        = RGB(255, 204, 153)
    With ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'желтый
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add(Range( _
        "E4:E100"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
        = RGB(255, 255, 153)
    With ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'зеленый
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add(Range( _
        "E4:E100"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
        = RGB(153, 255, 204)
    With ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Application.ScreenUpdating = True
End Sub
 
Перейти    
Как прописать в строке макроса символ - любая буква
 
#
23.08.2017 13:44:38
День добрый всем !

Возник вопрос как прописать в строке  макроса оператор  [Любая буква русского/англ алфавита] (важно чтобы была не цифра)
те 3 символ в слове дб именно буквой
Код
For Each y In Array("10 & Chr(41) & (любая буква - не цифра)", "11 & Chr(41) & (любая буква - не цифра)", "11 & Chr(41) & (любая буква - не цифра)")
 /////////////
Next
 
Перейти    
Перенос строк в ячейках диапазона по условию
 
#
21.08.2017 12:25:40

Добрый день всем !

Возникла трудность в написании макроса
Диапазон от U4 до последней заполненной строки
По критериям Как макросом произвести перенос строк в диапазоне U4 до последней заполненной строки (планируется до 5000 строк) по принципу - если встречается значение Перенос1,Перенос2,Перенос3,Перенос4,1),2),3),4),5),6) в ячейке диапазона    - то перенос производится перед этими значениями
& Chr(10) &  перенос  - но вот как уловить начало значения "Перенос1","Перенос2","Перенос3","Перенос4","1)","2)","3)","4)","5)","6)" в тексте по условию If(перед которыми производится перенос строк) ?
Файл с примером во вложении.

Макрос начал делать но как прописать перенос по условию ?

Код
Sub ПереносыТелефон()
With ActiveSheet.UsedRange
    LastRow As Long, r21Range As Range
    'LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
    LastRow = Cells.Find("*", [A1], SearchDirection:=xlPrevious).Row
'Делаем_Переносы_по значениям  21 столбец
Range("U4", Cells(LastRow, 21)).Select
Set r21Range = Intersect(Selection, ActiveSheet.UsedRange)
'Переносы 21 столбец по условиям начала значений
'If как определить здесь перенос по началу значений ?
End With
End Sub
 
Перейти    
Сортировка значений в столбце от мин к макс по части значения
 
#
14.08.2017 13:16:18
Добрый день всем !

Как справится с проблемой ?
В диапазоне F4:F2000  находятся  8-значные цифровые значения.  Нужно отсортировать значения в столбце F только по ПОСЛЕДНИМ  6 (шести) знакам (цифрам) от мин к максимальным значениям в столбце   - два первых знака на сортировку не должны влиять. Автофильтр на диапазон B3:O2000

Стандартный макрос сортировки от мин к макс и пример приложил.
Код
Sub Сортировка()
' Сортировка от минимального к максимальному
ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _
        Range("F3:F2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Перейти    
Скопировать значения из одного диапазона в другой на листе по условию
 
#
13.08.2017 20:21:14

Вечер добрый !

Как дописать макрос по условию такому:
Есть 2 соседних диапазона Z4:Z1000 и AC4:BP1000
В диапазоне Z4:Z1000 лежит текст,  в диапазоне AC4:BP1000 лежат ссылки типа www (в каждой ячейке 1 ссылка)
Часть ячеек диапазона AC4:BP1000 имеет цвет Interior.ColorIndex = 4
К исходному тексту в диапазоне Z4:Z1000 нужно добавить в конец текста только закрашенные ссылки из диапазона AC4:BP1000 в строке
в виде Ссылка1:(закрашенное значение из AC4:BP1000)  Ссылка2:(закрашенное значение из AC4:BP1000)  и тп
Файлик с примером прилагаю.

Код
Sub Perenos()
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 4 To LastRow
    'Проверка наличия текста  в ячейках столбца Z (26 столбец) чтоб макрос 2 раз не добавлял при 2 нажатии
    If Cells(i, 26) Like "*Обратить внимание на*" Then
    Cells(i, 26).Select
    Else
    'Иначе вставляем текст в ячейки столбца Z (26 столбец)
    Cells(i, 26).Value = "Обратить внимание на" & "Ссылка1:" & Cells(i, 31).Value ......... вот как здесь прописать условие для
 добавления значений из закрашенных ячеек из диапазона AC4:BP1000??
    End If
    NextEnd Sub
 
Перейти    
Макрос: проверка дублирования данных
 
#
10.08.2017 21:50:31
Вечер всем привет!
Макрос во вложении
макрос делает ссылки https  заменяя ссылки  типа rambler.ru на  https://www.rambler.ru в столбце b4  - макрос работает по кнопке
Все бы ничего - но при повторном запуске макроса (повторном нажатии кнопки) добавляются еще раз ссылки к существующему значению

Как сделать проверку в начале макроса если (If)  - если в столбце b4 уже есть https в значении  то макрос идет на выход (ничего не добавляет- идет на End Sub) ?
проверить нужно до первого совпадения мб пустые строки  
Изменено: olegvix - 10.08.2017 23:26:23
 
Перейти    
Страницы: 1
Наверх