Помогите пожалуйста написать макрос для многоуровневой сортировки. Допустим, имеется документ excel уже отсортированный сперва по адресу, а затем по цвету ячеек, данный документ формируется из программы написанной на delphi из трех файлов. Зелёные ячейки в верху, затем жёлтые и в конце красные, диапазон [B9:N9] и до конца документа.
Нужно после изменения цвета строки диапазона: - Переместить её в соответствующий цвет - И отсортировать по адресу
Юрий Родионов написал: Переместить её в соответствующий цвет
Перемещайте в синий, т.к. он не зеленый не желтый и не красный.
Цитата
отсортировать по адресу
Без проблем, только укажите номер индекса почтового отделения где находится адрес.
Цитата
формируется из программы написанной на delphi из трех файлов
А вот это уже совсем зря. Дельфину как минимум 5 файлов нужно. Вы этого не знали? Кусочек файла с пояснениями покажите, иначе будем продолжать искать соответствующий цвет и индекс почтового отделения.
Вот пример файла Допустим я внёс изменения в ячейках [I56] и [J56] и окрасил их в зелёный. Так мне надо чтобы он встал на 26 строку, как я только изменил цвет
Юрий Родионов, а есть логика установки цвета? или вы просто произвольно ее выбираете? а еще не понятно как отсортировано по адресу так как если сортировать по адресу будет совсем подругому
Юрий Родионов написал: Допустим я внёс изменения в ячейках [I56] и [J56] и окрасил их в зелёный. Так мне надо чтобы он встал на 26 строку
почему именно в 26?? а не в 50? поймите не понятна логика, удостойте нас своими разъяснениями почему именно так а видимо разъяснение "делает другая программа..." тогда в ней меняйте на зеленый цвет ифбудет сортировать как вам нужно, а макросу нужно написать что и когда делать.
Потому что когда оператор заносит с отчета руками у него в базе открыта вся улица и скакать не очень удобно из-за одного адреса Я вижу это так: после того как я изменил цвет, должна сработать сортировка сначала по цвету ячеек, а потом по столбцу "В" всего документа.
Юрий Родионов, это очень сложно не нужно) лучше запускать макрос с кнопки...
Код
Sub mrshkei()
Dim i As Long, n As Long, k As Long, lr As Long, col As New Collection, sh As Worksheet, sh2 As Worksheet, j As Long, j2 As Long
Set sh = ActiveSheet
Application.ScreenUpdating = False
k = 7 'начало строк с данными
lr = Cells(Rows.Count, 2).End(xlUp).Row 'посл. строка
For i = k To lr
On Error Resume Next
col.Add sh.Cells(i, 2).Interior.ColorIndex, CStr(sh.Cells(i, 2).Interior.ColorIndex)
Next i
Sheets.Add
With ActiveSheet
Set sh2 = ActiveSheet
.Name = Replace(Date, "-", "-")
j = 1
For n = 1 To col.Count
j2 = j
For i = k To lr
If sh.Cells(i, 2).Interior.ColorIndex = CDbl(col(n)) Then
sh.Range(sh.Cells(i, 2), sh.Cells(i, 14)).Copy Destination:=.Cells(j, 1)
j = j + 1
End If
Next i
'.Range(.Cells(j2, 1), .Cells(j - 1, 13)).Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range( _
"A" & j2 & ":A" & j - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A" & j2 & ":M" & j - 1)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Next n
sh.Activate
.Range("A1:M" & j - 1).Copy
sh.Cells(k, 2).Select
ActiveSheet.Paste
End With
Application.DisplayAlerts = False
sh2.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Цитата
Юрий Родионов написал: С макросами дело не имел никогда.