2

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:

enter image description here 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
4

3 回答 3

2

可以用 CF 来完成,例如(最重要的规则是 >11):

SO16274258 示例

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

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

SO16274258 第二个例子

于 2013-04-29T09:10:20.553 回答
2

我相信,如果您按列选择数据然后排序(而不是行限制范围),那么格式将随之而来。

编辑:

如果要锁定格式,请使用基于行号的条件格式,例如 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
于 2013-04-29T08:35:00.440 回答
1

开始了:

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

  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
    

它有帮助吗?

于 2013-04-29T08:55:42.090 回答