排序而不移动格式

Question

我有一个Excel表格，其中多行由VBA宏赋予不同颜色的背景。这些背景颜色应锁定到行。我的问题是，当表格按一列或另一列排序时，背景颜色随着数据的重新排序而移动。

我可以用其他方式格式化以阻止这种情况发生，以便细胞保持锁定吗？

我用来格式化的代码是：

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

Answer 1

我相信如果您按列选择数据然后排序（而不是行限制范围），则会进行格式化。

编辑：

如果要锁定格式，请使用基于行号的条件格式，例如ROW（）= x或ROW（）=值范围......

经过测试：通过公式设置规则使用条件格式，例如= 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

Answer 2

例如，

可以用CF完成（最高规则是> 11）：

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

下面的第二个使用=ROW($A1)=11：

Answer 3

我们走了：

在这种情况下，我会做两件事之一：

1. 条件格式。需要很多逻辑和手动步骤，所以让我们离开它。

2. 宏：无论何时对数据进行排序，请触发以下函数

   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
   

有帮助吗？