sorting不移动格式

我有一个Excel表格,其中多行由VBAmacros给予不同的彩色背景。 这些背景颜色应该locking到行。 我的问题是,当表按一列或另一列sorting时,背景颜色随着数据重新sorting而移动。

我可以用另一种方式进行格式化,以阻止这种情况的发生,使细胞保持locking?

我用来格式化的代码是:

For Each Row In rng.Rows If Condition Then Row.Select cIndex = ColourIndex(colour) With Selection.Interior .ColorIndex = cIndex End With End If Next 

我的表格的一个例子是这样的:

在这里输入图像说明 编辑:额外的代码

 Sub Quota(ByVal Type As String) Dim records As Long Dim sht1 As Worksheet Set sht1 = Worksheets("Sheet1") Dim sht2 As Worksheet Set sht2 = Worksheets("Sheet2") records = sht1.Range("A1048576").End(xlUp).Row - 5 Dim rng As Range Dim rngRowCount As Long Dim rLastCell As Range Dim i As Long sht2.Activate 'Last used cell Set rLastCell = sht2.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False) 'All used columns except 1st Set rng = sht2.Range(Cells(2, 1), rLastCell) rng.Select rngRowCount = rng.Rows.CountLarge For i = 1 To rngRowCount Dim valueAs String Dim colour As String Dim VarX As Long Dim maxValue As Long value= sht2.Cells(i + 1, 1).Value colour = sht2.Cells(i + 1, 2).Value If Type = "A" Then VarX = sht2.Cells(i + 1, 3).Value ElseIf Type = "B" Then VarX = sht2.Cells(i + 1, 5).Value End If maxValue = (records / 100) * VarX ColourRows value, colour, maxValue Next i End Sub Sub ColourRows(value As String, colour As String, maxValue As Long) Dim sht1 As Worksheet Set sht1 = Worksheets("Sheet1") sht1.Activate Dim rng As Range Dim firstSixRowsOnwards As Range Dim lastColumn As Long Dim usedColumns As Range Dim usedColumnsString As String Dim highlightedColumns As Range Dim rngDataRowCount As Long Dim performancevalueAs String Dim cIndex As Integer Dim count As Long count = 0 Dim rLastCell As Range 'End row rngDataRowCount = sht1.Range("A1048576").End(xlUp).Row 'First 6 rows Set firstSixRowsOnwards = sht1.Range("A6:XFD1048576") 'Last column lastColumn = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'Used Range Set rng = sht1.Range(Cells(1, 1), Cells(rngDataRowCount, lastColumn)) 'Used Columns Set usedColumns = sht1.Range(Cells(1, 1), Cells(1048576, lastColumn)) Set rng = Intersect(rng, firstSixRowsOnwards, usedColumns) For Each Row In rng.Rows compareValue= Cells(Row.Row, 5)).Value If (InStr(1, value, compareValue, 1) Then Dim rowNumber As Long Row.Select If count < maxValue Then cIndex = ColourIndex(colour) With Selection.Interior .ColorIndex = cIndex End With count = count + 1 Else cIndex = 3 'red With Selection.Interior .ColorIndex = cIndex End With End If End If Next End Sub 

我相信,如果你按列select你的数据,然后sorting(而不是行限制范围),然后格式化。

编辑:

如果要locking格式,则使用基于行号的条件格式,例如ROW()= x或ROW()=值的范围…

testing:使用公式设置规则的条件格式,例如= ROW()= 3,确保excel不会为您加倍引用,将其应用于整个数据范围。 第3行将随时按照您在此设置的格式进行设置。

在vba中设置

 Sub test() Range("A3").Select With Range("A3") .FormatConditions.Add Type:=xlExpression, Formula1:="=ROW()=3" .FormatConditions(1).Interior.ColorIndex = 46 End With End Sub 

例如可以用CF完成(最高规则> 11):

SO16274258的例子

编辑 – 我无意中遗漏了一条规则

下面第二行用=ROW($A1)=11

SO16274258第二个例子

开始了:

在这种情况下,我会做这两件事之一:

  1. 条件格式。 需要大量的逻辑和手动步骤,让我们离开它。
  2. macros:无论何时对数据进行sorting,请激活以下function

     Sub Option1() Dim row As Range Dim rowNum As Integer Dim tRange As Range 'set range here: in your example, it is A2:D11 Set tRange = ActiveSheet.Range("A2:D11") 'clear colors tRange.ClearFormats ' clears the previous format rowNum = 1 For Each row In tRange.Rows Select Case rowNum Case 1, 2 row.Interior.Color = RGB(255, 255, 0) ' 1 and 2nd will be yellow Case 3, 4 row.Interior.Color = 255 ' 3rd and 4th row will be red Case 5, 6 row.Interior.Color = RGB(0, 0, 255) ' 5 and 6th row will be blue Case Else row.Interior.Color = RGB(0, 255, 0) '' all the bottom row would be a Green row End Select rowNum = rowNum + 1 Next row End Sub 

它有帮助吗?