基本上我正在嘗試按顏色對帶有宏的一堆行進行排序和分組

我已經設法對行進行排序,但我找不到“分組”的方法,或者可能更好的“選擇”,第一個單元格值的行,所以我可以更改背景顏色
我不認為這很有用,但我把代碼放得這么遠
Sub Macro2()
'
' Macro2 Macro
'
'
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$100"), , xlYes).Name = _
"Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight14"
ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1").Sort. _
SortFields.Add Key:=Range("Table1[[#All],[StaffName]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
uj5u.com熱心網友回復:
這是一個如何做到這一點的示例:
Sub ColorRows()
Dim lst As ListObject, c As Range, rw As ListRow, staff, indx As Long
Dim arrColors, dict As Object, clrIndex As Long
Set dict = CreateObject("scripting.dictionary")
Set lst = ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1")
indx = lst.ListColumns("StaffName").Index 'the position of the Staffname column
arrColors = Array(vbRed, vbYellow, vbBlue, vbGreen, vbMagenta) 'or whatever you like...
For Each rw In lst.ListRows 'loop over all the list rows
With rw.Range 'look at the Range for each row
staff = .Cells(indx).Value 'get the staff name
If Not dict.exists(staff) Then 'new name? Store name and next color
'find the index into the colors array...
clrIndex = dict.Count Mod (UBound(arrColors) 1) 'mod loops if more values than colors
Debug.Print staff, clrIndex
dict.Add staff, arrColors(clrIndex) 'store the staffname and the color
End If
.Interior.Color = dict(staff) 'apply the color
End With
Next rw
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/net/433509.html
