Excel VBA – Применить автоматический фильтр и Сортировать по определенному цвету

У меня есть профиль с автофильтрацией. Автофильтр был создан следующим кодом VB:

Sub Colour_filter() Range("A4").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Selection.AutoFilter End Sub 

Я хотел бы сортировать значения в столбце «А» (фактические данные начинаются с ячейки «А4») следующим цветом (Цвет = RGB (255, 102, 204)), поэтому все ячейки с этим цветом сортируются вверх ,

Было бы здорово, если бы дополнительный код мог быть добавлен к моему существующему коду?

Мой офис действительно шумный, и мой VB не самый лучший. Это вдвойне тяжело смеется, общается с леди. Любая помощь будет снятием стресса! (ps не мечут у дам, это всего лишь мой офис – 95% женщин).


Отредактировано по запросу @ScottHoltzman.

Мой запрошенный код является частью более крупного кода, который сбивает с толку, хотя здесь есть уменьшенная версия аспекта, который мне сейчас нужен.

 Sub Colour_filter() ' Following code( using conditional formatting) adds highlight to 'excluded' courses based 'on 'course code' cell value matching criteria. Courses codes matching criteria are highlighted 'in 'Pink'; as of 19-Nov-2012 the 'excluded' course codes are '(BIGTEST, BIGFATCAT). ' <====== CONDITIONAL FORMATTING CODE STARTS HERE =======> Columns("A:A").Select Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _ Formula1:="=""BIGTEST""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .Color = 13395711 End With Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _ Formula1:="=""BIGFATCAT""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .Color = 13395711 End With ' <====== CONDITIONAL FORMATTING CODE ENDS HERE =======> ' Following code returns column A:A to Font "Tahoma", Size "8" Columns("A:A").Select With Selection.Font .Name = "Tahoma" .FontStyle = "Regular" .Size = 8 .ThemeColor = xlThemeColorLight1 .ThemeFont = xlThemeFontNone End With With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = False End With ' Following code adds border around all contiguous cells ion range, similar to using keyboard short cut "Ctrl + A". Range("A4").Select ActiveCell.CurrentRegion.Select With Selection Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone End With With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With ' Following code adds 'Blue' cell colour to all headers in Row 4 start in Cell "A4". Range("A4").Select Range(Selection, Selection.End(xlToRight)).Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorLight2 .TintAndShade = 0.399975585192419 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With Selection.Font.Bold = True '<== adds auto-filter to my range of cells ===> Range("A4").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Selection.AutoFilter End Sub 

Ну вот небольшой Sub который выполняет следующую сортировку в соответствии с показанным изображением. Большинство значений, таких как размеры / размеры диапазона, очень статичны, поскольку это образец. Вы можете улучшить динамику. Прокомментируйте, если этот код идет в правильном направлении, поэтому я могу обновить окончательный вид.

РЕДАКТИРОВАННЫЙ КОД С ДВОЙНЫМИ КОРРЕЛЯМИ

код: Option Explicit

Sub sortByColor () Dim rng As Range
Dim i As Integer Dim inputArray As Variant, colourSortID As Variant Dim colourIndex As Long

 Set rng = Sheets(1).Range("D2:D13") colourIndex = Sheets(1).Range("G2").Interior.colorIndex ReDim inputArray(1 To 12) ReDim colourSortID(1 To 12) For i = 1 To 12 inputArray(i) = rng.Cells(i, 1).Interior.colorIndex If inputArray(i) = colourIndex Then colourSortID(i) = 1 Else colourSortID(i) = 0 End If Next i '--output the array with colourIndexvalues and sorting key values Sheets(1).Range("E2").Resize(UBound(inputArray) + 1) = _ Application.Transpose(inputArray) Sheets(1).Range("F2").Resize(UBound(colourSortID) + 1) = _ Application.Transpose(colourSortID) '-sort the rows based on the interior colour Application.DisplayAlerts = False Set rng = rng.Resize(, 3) rng.Sort Key1:=Range("F2"), Order1:=xlDescending, _ Key2:=Range("E2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Application.DisplayAlerts = True End Sub 

вывод:

введите описание изображения здесь

  • C #, открыть файл excel и применить фильтр для извлечения определенных строк?
  • Excel 2013: код VBA для фильтрации данных рабочего листа из нескольких вариантов списка
  • Excel VBA для проверки автофильтра для данных
  • Макрос Excel для включения параметра в диапазон
  • Как создать Excel с функцией Autofilter от ObservableCollection в C #
  • Фильтр с использованием массива и xlFilterValues
  • Неверная фильтрация строк на одном листе на основе массива со значениями из другого листа в VBA
  • Фильтр Microsoft Excel Spreadsheet с ячейками с несколькими значениями
  • Excel VBA - Autofilter столбец даты на набор даты
  • Печать массива AutoFilter в ближайшее окно
  • Ошибка: невозможно получить свойство AutoFilter класса Range
  • Давайте будем гением компьютера.