vba 排序而不移动格式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16274258/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Sort without moving formatting
提问by baarkerlounger
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.
我有一个 Excel 表格，其中多行由 VBA 宏赋予不同颜色的背景。这些背景颜色应锁定到行。我的问题是，当表格按一列或另一列排序时，背景颜色会随着数据的重新排序而移动。
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
回答by Al.
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...
如果要锁定格式，请使用基于行号的条件格式，例如 ROW() = x 或 ROW() = 值范围...
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.
测试：通过公式集规则使用条件格式，例如 =ROW()=3 确保 excel 不会为您双引号，将其应用于整个数据范围。第 3 行将始终按照您在此处设置的格式进行格式化。
Setting in vba
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
回答by pnuts
Can be done with CF, for example (top rule is >11):
可以用 CF 来完成，例如（最高规则是 >11）：
Edit - I inadvertently left out one rule
编辑 - 我无意中遗漏了一条规则
the second down below uses =ROW($A1)=11:
下面的第二个使用=ROW($A1)=11：
回答by Vikas
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
- 条件格式。需要很多逻辑和手动步骤，所以让我们离开它。
宏：每当您对数据进行排序时，请触发以下功能
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?
它有帮助吗？
