Excel VBA – 应用自动filter和按特定颜色sorting
我有一个自动筛选的数据范围。 自动filter是由以下VB代码创build的：
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 我想用下列颜色（Color = RGB（255,102,204））对“A”列中的数据进行sorting（数据实际上是从单元格“A4”开始的），因此所有具有该颜色的单元格sorting为顶部。
如果额外的代码可以添加到我现有的代码，这将是工厂？
我的办公室真的很吵，我的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 ，按照显示的图像进行以下sorting。 由于这是一个示例，因此大多数值（如维度/范围大小）都是非常静态的。 你可以改进它是dynamic的。 请评论，如果这个代码是在正确的方向，所以我可以更新与最后的sorting。
EDITTED代码与双排KYES
代码：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
输出：
