Excel VBA - 应用自动过滤器和按特定颜色排序 [英] Excel VBA - Apply auto filter and Sort by specific colour

查看：388
本文介绍了Excel VBA - 应用自动过滤器和按特定颜色排序的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我有一个自动过滤的数据范围。自动过滤器由以下VB代码创建：

  Sub Colour_filter（）
 
范围（选择
范围（Selection，Selection.End（xlToRight））。选择
范围（Selection，Selection.End（xlDown））。选择
 Selection.Copy 
 Selection.PasteSpecial Paste：= xlPasteValues，操作：= xlNone，SkipBlanks：= False，Transpose：= False 
 Selection.AutoFilter 
 
 End Sub

我想在列A（数据实际上从单元格A4开始）中通过以下颜色（颜色= RGB（ 255，102，204）），所以所有具有该颜色的单元格排序到顶部。



如果额外的代码可以添加到我现有的代码中，那将是fab？



我的办公室真的很嘈杂，我的VB不是最好的。笑起来是双重的，聊天的女士们都是这样。任何帮助将是压力救济天堂！ （ps没有捅在女士们只是我的办公室是95％的女性）。





根据@ScottHoltzman的请求编辑。



我所请求的代码是一个较大的代码的一部分，这将使事情变得混乱，尽管这是我目前需要的这个方面的一个细微的版本。

  Sub Colour_filter（）
'以下代码（使用条件格式）将排除课程的亮点添加到
'上的课程代码'细胞值匹配标准。 Pink中的课程代码匹配条件突出显示为
'截至2012年11月19日，排除课程代码为
'（BIGTEST，BIGFATCAT）。 
 
'< ======此处的条件格式化代码起始=======> 
列（A：A）。选择
 Selection.FormatConditions.Add类型：= xlCellValue，运算符：= xlEqual，_ 
 Formula1：==BIGTEST
 Selection.FormatConditions（Selection.FormatConditions.Count）.SetFirstPriority 
 With Selection.FormatConditions（1）.Interior 
 .Color = 13395711 
结束
 
 Selection.FormatConditions.Add类型：= xlCellValue，运算符：= xlEqual，_ 
 Formula1：==BIGFATCAT
 Selection.FormatConditions（Selection.FormatConditions.Count）.SetFirstPriority 
与Selection.FormatConditions（1）。内部
 .Color = 13395711 
 
结束
 
'< ======条件格式化代码在这里=======> 
 
'以下代码返回列A：A到字体Tahoma，大小8
列（A：A）。选择
 With Selection.Font 
 .Name =Tahoma
 .FontStyle =Regular
 .Size = 8 
 .ThemeColor = xlThemeColorLight1 
 .ThemeFont = xlThemeFontNone 
 
结束与
与选择
 .Horizo​​ntalAlignment = xlLeft 
 .VerticalAlignment = xlTop 
 .WrapText = False 
结束
 
'以下代码添加围绕所有连续的细胞离子范围，类似于使用键盘快捷键Ctrl + A。 
 Range（A4）。选择
 ActiveCell.CurrentRegion.Select 
 
 
带选择
 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 
结束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（xlInsideHorizo​​ntal）
 .LineStyle = xlContinuous 
 .ColorIndex = xlAutomatic 
 .TintAndShade = 0 
 .Weight = xlThin 
结束
 
 
 
'以下代码为单元格A4中的第4行中的所有标题添加蓝色单元格颜色。选择
范围（Selection，Selection.End（xlToRight））。选择
选择
 .Horizo​​ntalAlignment = 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 
结束与
与Selection.Font 
 .ThemeColor = xlThemeColorDark1 
 .TintAndShade = 0 
结束使用
 Selection.Font.Bold = True 
 
'< ==将自动过滤器添加到我的单元格范围===> 
 
范围（A4）。选择
范围（Selection，Selection.End（xlToRight））。选择
范围（Selection，Selection.End（xlDown） 
 Selection.Copy 
 Selection.PasteSpecial粘贴：= xlPasteValues，操作：= xlNone，SkipBlanks：= False，Transpose：= False 
 Selection.AutoFilter 
 
 End Sub


解决方案

这里是一个小的 Sub 根据显示的图像执行以下排序。大多数值，如尺寸/范围大小是非常静态的，因为这是一个示例。您可以将其改善为动态。 请注意，如果此代码正确方向，我可以使用最终排序进行更新。



已编辑双重排序代码KYES



代码：
选项显式



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到12）
 ReDim colourSortID（1到12）
 
对于i = 1到12 
 inputArray（i）= rng.Cells i，1）.Interior.colorIndex 
如果inputArray（i）= colourIndex然后
 colourSortID（i）= 1 
 Else 
 colourSortID（i）= 0 
结束如果
 Next i 
 
' - 使用colourIndexvalues和排序键值输出数组
表（1）.Range（E2）。调整大小（UBound（inputArray）+ 1）= _ 
 Application.Transpose（inputArray）
表格（1）.Range（F2）。调整大小（UBound（colourSortID）+ 1）= _ 
 Application.Transpose（colourSortID）
 
'根据内部颜色对行进行
 Application.DisplayAlerts = False 
设置rng = rng.Resize（，3）
 
 rng.Sort Key1：=范围（ F2），Order1：= xlDescending，_ 
 Key2：= Range（E2），Order1：= xlAscending，Header：= xlNo，_ 
 OrderCustom：= 1，MatchCase：= False，方向：= xlTopToBottom，_ 
 DataOption1：= xlSortNormal 
 
 Application.DisplayAlerts = True 
 
 End Sub 
  pre> 
 
 
输出：
 
 
 
  
 
I have an auto-filtered range of data. The auto filter was created by the following VB code:
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

I would like to sort the values in column "A" (the data actually start from cell "A4") by the following colour ( Color = RGB(255, 102, 204) ) so all the cells with that colour sort to the top.



It would be fab if the extra code could be added to my existing code?



My office is really noisy and my VB isn’t the best. It is doubly hard with laughing, chatting ladies all about. Any help will be stress relief heaven!! (p.s. no poke at the ladies it’s just my office is 95% women).






Edited per request by @ScottHoltzman.



My requested code forms part of a larger code which would confuse matters, although here is a slimmed down version of the aspect I currently need.
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



 解决方案 
Well here is a small Sub that does the following sorting as per shown image. Most of the values like dimensions/range sizes are very static since this is a sample. You may improve it to be dynamic. Please comment if this code is going in the right direction so I can update with the final sort.



EDITTED CODE WITH DOUBLE SORT KYES



code:
  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

output:





                        
这篇关于Excel VBA  - 应用自动过滤器和按特定颜色排序的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
相关文章
Office最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆