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".