sorting - 排序而不移动格式

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