如何对excel 2003中的单元格进行颜色排序？

Question

我希望在每行的六个单元格（现实生活中的商店）中输入背景颜色，从高到低的绿色排序为红色。

在 excel 2010 中就像照片，但在 2003 版本中不起作用...我如何在 excel 2003 中做到这一点？ 照片http://img32.imageshack.us/img32/4909/srv20130328113621.png

在 excel 2010 中，我使用此代码并且工作完美

If Application.Version >= "12.0" Then
    For counter = 3 To 103
        Range("I" & counter & ",K" & counter & ",M" & counter & ",O" & counter & ",Q" & counter & ",S" & counter).Select
        Selection.FormatConditions.AddColorScale ColorScaleType:=3
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 7039480
    End If
    End With
        Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
        Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
    End If
    End With
        Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 8109667
    End If
    End With
    Next counter
Else
End If

对不起，我的英语不好。

Answer 1

好的！这段代码完美运行！

在第一个 sub xromata（希腊语中的颜色）中，我为不同的工作表设置了一些。 在此之后调用 sortarisma，参考第一列与第二列和行数不同！

Sub Xromata(a As Integer)
    If a = 1 Then
        Call Sortarisma(11, 3, 103)
        ElseIf a = 2 Then
        Call Sortarisma(12, 3, 111)
        ElseIf a = 3 Then
        Call Sortarisma(9, 2, 103)
        ElseIf a = 4 Then
        Call Sortarisma(10, 2, 111)
        ElseIf a = 5 Then
        Call Sortarisma(11, 4, 103)
        Call Sortarisma(12, 4, 103)
        ElseIf a = 6 Then
        Call Sortarisma(12, 4, 111)
        Call Sortarisma(13, 4, 111)
    Else
End If

End Sub
Sub Sortarisma(arxi As Integer, per As Integer, numofrows As Integer)

Dim Arr(1 To 6) As Single
Dim i As Integer
Dim l As Integer
Dim k As Integer
Dim j As Integer
Dim ff As Integer
Dim ll As Integer
Dim temp As Single
ff = 1
ll = 6

For i = 3 To numofrows
    temp = 0
    Arr(1) = Cells(i, arxi)
    Arr(2) = Cells(i, arxi + per)
    Arr(3) = Cells(i, arxi + (per * 2))
    Arr(4) = Cells(i, arxi + (per * 3))
    Arr(5) = Cells(i, arxi + (per * 4))
    Arr(6) = Cells(i, arxi + (per * 5))

    For k = ff To ll - 1
        For j = k + 1 To ll
            If Arr(k) > Arr(j) Then
            temp = Arr(j)
            Arr(j) = Arr(k)
            Arr(k) = temp
            End If
        Next j
    Next k
    ''''''''''''''''''''
    For l = arxi To arxi + (per * 5) Step per
        If Cells(i, l) = Arr(1) And Cells(i, l) >= 0 Then
            Call xromatismos_keliou(i, l, 6)
        ElseIf Cells(i, l) = Arr(2) And Cells(i, l) >= 0 Then
            Call xromatismos_keliou(i, l, 5)
        ElseIf Cells(i, l) = Arr(3) And Cells(i, l) >= 0 Then
            Call xromatismos_keliou(i, l, 4)
        ElseIf Cells(i, l) = Arr(4) And Cells(i, l) >= 0 Then
            Call xromatismos_keliou(i, l, 3)
        ElseIf Cells(i, l) = Arr(5) And Cells(i, l) >= 0 Then
            Call xromatismos_keliou(i, l, 2)
        ElseIf Cells(i, l) = Arr(6) And Cells(i, l) >= 0 Then
            Call xromatismos_keliou(i, l, 1)
        ElseIf Cells(i, l) = Arr(1) And Cells(i, l) < 0 Then
            Call xromatismos_keliou(i, l, 6)
        ElseIf Cells(i, l) = Arr(2) And Cells(i, l) < 0 Then
            Call xromatismos_keliou(i, l, 5)
        ElseIf Cells(i, l) = Arr(3) And Cells(i, l) < 0 Then
            Call xromatismos_keliou(i, l, 4)
        ElseIf Cells(i, l) = Arr(4) And Cells(i, l) < 0 Then
            Call xromatismos_keliou(i, l, 3)
        ElseIf Cells(i, l) = Arr(5) And Cells(i, l) < 0 Then
            Call xromatismos_keliou(i, l, 2)
        ElseIf Cells(i, l) = Arr(6) And Cells(i, l) < 0 Then
            Call xromatismos_keliou(i, l, 1)
        End If
    Next l
    Next i
Call addindex(numofrows + 2)
Application.Goto Reference:=Range("a1"), Scroll:=True
End Sub
Sub xromatismos_keliou(row As Integer, col As Integer, bathmos As Integer)

If bathmos = 1 Then
    Cells(row, col).Interior.ColorIndex = 10
    ElseIf bathmos = 2 Then
    Cells(row, col).Interior.ColorIndex = 50
    ElseIf bathmos = 3 Then
    Cells(row, col).Interior.ColorIndex = 43
    ElseIf bathmos = 4 Then
    Cells(row, col).Interior.ColorIndex = 44
    ElseIf bathmos = 5 Then
    Cells(row, col).Interior.ColorIndex = 45
    ElseIf bathmos = 6 Then
    Cells(row, col).Interior.ColorIndex = 46
    Cells(row, col).Select
    With Selection.Font
    .Bold = True
    End With

    Else
End If

End Sub
Sub addindex(thesi As Integer)

Cells(thesi, 1).Interior.ColorIndex = 10
Cells(thesi, 1).Value = "1"
Cells(thesi, 2).Interior.ColorIndex = 50
Cells(thesi, 2).Value = "2"
Cells(thesi, 3).Interior.ColorIndex = 43
Cells(thesi, 3).Value = "3"
Cells(thesi, 4).Interior.ColorIndex = 44
Cells(thesi, 4).Value = "4"
Cells(thesi, 5).Interior.ColorIndex = 45
Cells(thesi, 5).Value = "5"
Cells(thesi, 6).Interior.ColorIndex = 46
Cells(thesi, 6).Value = "6"

End Sub