Fråga en expert Kan man sortera på cellernas fyllnadsfärg? |
|
Frågan: När jag granskar ett omfattande kalkylark markerar jag celler av intresse med olika fyllnadsfärg beroende på kategori. Hur gör jag för att sortera alla rader efter fyllnadsfärgen så att kategorier samlar sig? Svar: Sorteringsfunktion i Excel arbetar enbart med innehållet i cellerna och inte med deras egenskaper. För att sortera på fyllnadsfärgen måste man först extrahera färgens värde till en ledig cell på samma rad. Därefter kan man sortera på dessa färgvärden. För att komma åt färgvärden måste man använda en makro som anropar metoden Interior.ColorIndex för att läsa ut fyllnadsfärgens kod. Alla färger har en kod som är ett heltal större än 0 (svart ger +1) medan celler utan fyllnadsfärg returnerar ett heltal mindre än 0 (-4142). Eftersom färgvärden ska läggas i en egen cell måste det finnas en ledig kolumn i kalkylarket (maximalt kan det finnas 256 kolumner i ett ark varför den sista kolumnen får etiketten IV. För att göra det hela användarvänligt låter vi makrot utöka arket med en tillfällig kolumn där färgkoderna lagras. Efter sortering på färgkoderna tas kolumnen bort. Det hela kompletteras med felkontroller, förklaringar och även möjligheten att sortera på kolumner. Användningssättet är att markera delen av en rad eller kolumn, som innehåller de celler man önskar sortera på dess fyllnadsfärg, och sedan anropa makrot. Sub SortOnFill() Dim Selekterad As String Dim KolumnSort As Boolean Dim KolumnStart As String Dim KolumnSlut As String Dim Dollar As Integer Dim RadStart As String Dim RadSlut As String Dim KolumnIndex As Integer Dim RadIndex As Integer Dim Kolon As Integer ' Kollar urvalet Selekterad = ActiveWindow.RangeSelection.Address Kolon = InStr(Selekterad, ":") If Kolon = 0 Then MsgBox "Du måste välja mer än en cell", vbInformation, "Ogiltig selektion" MsgBox "Denna makro sorterar de kolumner eller rader som den" & vbCrLf _ & "markerade kolumnen eller raden omfattar i stigande ordning" & vbCrLf _ & "på det decimala värdet av de markerade cellernas fyllnadsfärger." _ & vbCrLf & "För att sortering ska genomföras infogas en tillfällig" _ & " kolumn eller rad" & vbCrLf & "där färgvärden lagras varför" _ & " kalkylarkets högsta kolumn (IV) eller högsta" & vbCrLf _ & "rad (65536) måste vara oanvänd. Celler utan fyllnadsfärg har ett" _ & " värde av" & vbCrLf & "-4142 medan alla andra fyllnadsfärger har" _ & " värden större än 0.", vbInformation, "Makrons funktion" Exit Sub End If If Kolon = 3 Then MsgBox "Du kan inte välja en hel rad eller en hel kolumn" & vbCrLf _ & "utan välj en del av en rad eller en del av en kolumn", vbExclamation, _ "Ogiltig selektion" Exit Sub End If ' Kolla att man valt enbart en rad eller en kolumn KolumnStart = Mid(Selekterad, 2, InStr(2, Selekterad, "$") - 2) KolumnSlut = Mid(Selekterad, Kolon + 2, InStr(Kolon + 2, Selekterad, "$") _ - Kolon - 2) Dollar = InStr(2, Selekterad, "$") RadStart = Mid(Selekterad, Dollar + 1, Kolon - Dollar - 1) Dollar = InStr(Kolon + 2, Selekterad, "$") RadSlut = Mid(Selekterad, Dollar + 1, Len(Selekterad) - Dollar) If KolumnStart < KolumnSlut And RadStart < RadSlut Then MsgBox "Du har selekterat mer än en kolumn eller en rad" & vbCrLf _ & "Du måste selektera enbart en kolumn eller rad", vbInformation, _ "Ogiltig selektion" Exit Sub End If ' Stäng av skärmuppdatering Application.ScreenUpdating = False ' Infogar en rad eller en kolumn för färgkoderna If KolumnStart <> KolumnSlut Then Range(KolumnStart & RadStart & ":" & KolumnSlut & RadStart).Select Selection.EntireRow.Insert Else Range(KolumnStart & RadStart & ":" & KolumnStart & RadSlut).Select Selection.EntireColumn.Insert End If ' Fyll den raden/kolumnen med färgkoderna If KolumnStart <> KolumnSlut Then For KolumnIndex = Asc(KolumnStart) To Asc(KolumnSlut) Range(Chr(KolumnIndex) & Mid(Str(RadStart), 2)).Value = _ Range(Chr(KolumnIndex) & Mid(Str(RadStart + 1), 2)).Interior.ColorIndex Next KolumnIndex Else For RadIndex = Val(RadStart) To Val(RadSlut) Range(KolumnStart & Mid(Str(RadIndex), 2)).Value = _ Range(Chr(Asc(KolumnStart) + 1) _ & Mid(Str(RadIndex), 2)).Interior.ColorIndex Next RadIndex End If ' Selektera raderna eller kolumnerna som ska sorteras If KolumnStart <> KolumnSlut Then Range(Columns(KolumnStart), Columns(KolumnSlut)).Select Else Range(Rows(RadStart), Rows(RadSlut)).Select End If ' Sortera selekteringen If KolumnStart <> KolumnSlut Then Selection.Sort Key1:=Columns(KolumnStart), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, DataOption1:=xlSortNormal Else Selection.Sort Key1:=Range("A" & RadStart), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, DataOption1:=xlSortNormal End If ' Ta bort raden eller kolumnen med färgkoderna If KolumnStart <> KolumnSlut Then Range(KolumnStart & RadStart & ":" & KolumnSlut & RadStart).Select Selection.EntireRow.Delete Else Range(KolumnStart & RadStart & ":" & KolumnStart & RadSlut).Select Selection.EntireColumn.Delete End If ' Sätt på skärmuppdatering Application.ScreenUpdating = True End Sub koden ovan förutses finnas på kodsidan till arket man arbetar med eller i arket med namn 'bok.xlt' i mappen "xlstart". |