Снова здравствуйте! Вопрос такой, можно ли сделать дополнительную (есть уже прописанная сортировка по дате) сортировку по цвету шрифта дат (только в столбцах дат)? Если одинаковые даты, а цвет у них разный. Чтобы красный шел впереди, потом зеленый, а потом черный. Спасибо!
Снова здравствуйте! Вопрос такой, можно ли сделать дополнительную (есть уже прописанная сортировка по дате) сортировку по цвету шрифта дат (только в столбцах дат)? Если одинаковые даты, а цвет у них разный. Чтобы красный шел впереди, потом зеленый, а потом черный. Спасибо!Morfeysis
Можно, конечно! Только что ж так неймётся делать из табличного редактора разукраску?! Как малые дети, право! Ну раз уже а вас есть процедура впишите в неё сортировку
Можно, конечно! Только что ж так неймётся делать из табличного редактора разукраску?! Как малые дети, право! Ну раз уже а вас есть процедура впишите в неё сортировкуalex77755
Могу помочь в VB6, VBA Alex77755@mail.ru
Сообщение отредактировал alex77755 - Среда, 26.02.2014, 12:58
Та вот такое мне дали задание( А это можно как то сделать так, что не настраивать каждый раз? Помогите, пожалуйста, потому что я чувствую, что туплю)
Та вот такое мне дали задание( А это можно как то сделать так, что не настраивать каждый раз? Помогите, пожалуйста, потому что я чувствую, что туплю)Morfeysis
Sub ertert() Dim r As Range: Application.ScreenUpdating = False With Range("A2", Cells(Rows.Count, 1).End(xlUp)) For Each r In .Cells Select Case r.Font.Color Case vbRed: r(1, 3) = CLng(r) & 1 Case vbGreen: r(1, 3) = CLng(r) & 2 Case vbBlack: r(1, 3) = CLng(r) & 3 End Select Next r With .Resize(, 3) .Sort Key1:=.Cells(1, 3), Order1:=xlAscending End With .Offset(, 2).ClearContents End With Application.ScreenUpdating = True End Sub
[/vba]
попробуйте так (с кнопочкой) [vba]
Код
Sub ertert() Dim r As Range: Application.ScreenUpdating = False With Range("A2", Cells(Rows.Count, 1).End(xlUp)) For Each r In .Cells Select Case r.Font.Color Case vbRed: r(1, 3) = CLng(r) & 1 Case vbGreen: r(1, 3) = CLng(r) & 2 Case vbBlack: r(1, 3) = CLng(r) & 3 End Select Next r With .Resize(, 3) .Sort Key1:=.Cells(1, 3), Order1:=xlAscending End With .Offset(, 2).ClearContents End With Application.ScreenUpdating = True End Sub
Что-то не то( Оно должно сначала сортировать по дате, а потом по цвету шрифта. Здесь, когда нажимаешь на SORT, зеленый шрифт кидает в самый низ.
Что-то не то( Оно должно сначала сортировать по дате, а потом по цвету шрифта. Здесь, когда нажимаешь на SORT, зеленый шрифт кидает в самый низ.Morfeysis