我有一个 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
最佳答案
我相信,如果您按列选择数据,然后排序(而不是行限制范围),那么格式化就会随之而来。
编辑:
如果您想锁定格式,请使用基于行号的条件格式,例如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
关于sorting - 排序而不移动格式,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/16274258/