Sort without moving formatting

问题

I have an Excel table in which multiple rows are given different coloured backgrounds by VBA macros. These background colours should be locked to the rows. My problem is that when the table is sorted by one column or another the background colours move as the data is reordered.

Can I format in another way to stop this happening so that the cells remain locked?

The code I use to format is:

For Each Row In rng.Rows

If Condition Then

   Row.Select

   cIndex = ColourIndex(colour)
   With Selection.Interior
       .ColorIndex = cIndex
   End With

End If    
Next

An example of my table is like this:

EDIT: Extra Code

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

回答1:

I believe that if you select your data by column and then sort (instead of a row limited range) then formatting will follow.

EDIT:

If you want to lock the formatting then use conditional formatting that is based on row number, e.g. ROW() = x or ROW() = range of values...

Tested: Use conditional formatting by formula set rule such as =ROW()=3 make sure excel does not double quote it for you, apply this to the entire data range. Row 3 will then always be formatted as you set here.

Setting in 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

回答2:

Can be done with CF, for example (top rule is >11):

Edit - I inadvertently left out one rule

the second down below uses =ROW($A1)=11:

回答3:

Here we go:

In this case, what I would do it one of the two things:

Conditional formatting. Needs lot of logics and manual steps so let us leave it.

A macro: Whenever you sort the data, please fire the following 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

Does it help?

来源：https://stackoverflow.com/questions/16274258/sort-without-moving-formatting

标签

excel

sorting

excel-vba

formatting

vba