排序不動，格式化

Question

我在這多行由VBA宏給出不同顏色的背景Excel表格。這些背景顏色應該鎖定到行。我的問題是，當表由一列或排序的數據重新排序另一個背景色移動。

我可以用另一種方式來阻止這種情況的發生格式化使細胞保持鎖定？

我使用的格式的代碼是：

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

這裏，我們去：

在這種情況下，我會做的兩兩件事之一：

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 
   

幫助？

Answer 3

可與CF來完成，例如（頂部規則> 11）：

編輯 - 我無意間忽略了一個規則如下

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