单元格填充颜色求助

crega123

我有一个退票表，当日订票的，填充黄色（当日是指工作簿名称的数字部分）；其它订票日期（都是当日之前的日期），按发车时间项升序后，分别按不同发车日期填充不同颜色。但有两个可能性，第一个可能是，没有当日订票的车票；第二个可能是，没有其它订票日期的车票，这些要用到Go to语句。如果全都有，我做好了代码，但以上两个可能性，不知怎么用语句：

Sub 退票汇总()
   Dim m%, t As String, y As Long, arng As Range, a%, b%
    For m = 2 To [A2].CurrentRegion.Rows.Count  'm为2到K列有数据的所有行号,在订票时间后面标明"退票"字样
        w = Range("a1").End(xlDown).Row
        Cells(m, 11) = "退票"
    Next
    Range("M2").Formula = "=LEFT(J2,10)"
    For i = 2 To Range("j2").End(xlDown).Row
        Cells(i, 13) = Format(Left(Cells(i, 10), 10), "yyyymmdd")
    Next
    For q = 2 To Range("j2").End(xlDown).Row
        t = ActiveWorkbook.Name
        y = val(Mid(t, 5))
        u = Application.Max(Range("M" & q))
        If y = u Then
            If arng Is Nothing Then
                Set arng = Range("M" & q)
            Else
                Set arng = Union(arng, Range("M" & q))
                arng.Select
                a = Selection.Rows(1).Row
                b = Selection.Rows(Selection.Rows.Count).Row
                Range(Cells(a, 1), Cells(b, 11)).Interior.ColorIndex = 6
            End If
        End If
    Next
    With Range(Cells(2, 1), Cells(a, 12).Offset(-1, 0))
        .Sort Key1:=Range("d1"), Order1:=xlAscending, Header:=xlYes
    End With
    Dim e%, color%
    Set d = CreateObject("scripting.dictionary")
    S = Cells(a, 1).Offset(-1, 0).Row()
    For e = 2 To S
        dt = Format(Cells(e, 4), "yyyymmdd")
        If d.Exists(dt) Then
            Set d(dt) = Union(d(dt), Cells(e, 1).Resize(1, 11))
        Else
            Set d(dt) = Cells(e, 1).Resize(1, 11)
        End If
    Next
    For j = 0 To d.Count - 1
        d.items()(j).Interior.ColorIndex = j + 37 Mod 56
    Next j

    If u < y Then
        With Range("a1").CurrentRegion
            .Sort Key1:=Range("d1"), Order1:=xlAscending, Header:=xlYes
        End With
        Dim k%, color2%
        Set d2 = CreateObject("scripting.dictionary")
        s1 = Range("a1").End(xlUp).Row
        For e1 = 2 To s1
            dt = Format(Cells(e1, 4), "yyyymmdd")
            If d.Exists(dt1) Then
                Set d(dt1) = Union(d2(dt1), Cells(e1, 1).Resize(1, 11))
            Else
                Set d2(dt1) = Cells(e1, 1).Resize(1, 11)
            End If
        Next
        For j1 = 0 To d2.Count - 1
            d2.items()(j1).Interior.ColorIndex = j1 + 37 Mod 56
        Next j1
    End If
    Application.ScreenUpdating = True
End Sub
   

crega123

我已做好了，有人能帮我修改一下代码吗？
Sub 退票汇总()
    Application.ScreenUpdating = False
    Range("K1").CurrentRegion.Select
    With Selection
        .Sort Key1:=Range("j1"), Order1:=xlAscending, Header:=xlYes
    End With
    Dim m%, t As String, y As Long, arng As Range, a%, b%
    For m = 2 To [A2].CurrentRegion.Rows.Count  'm为2到K列有数据的所有行号,在订票时间后面标明"退票"字样
        w = Range("a1").End(xlDown).Row
        Cells(m, 11) = "退票"
    Next
    Range("M2").Formula = "=LEFT(J2,10)"
    For i = 2 To Range("j2").End(xlDown).Row
        Cells(i, 13) = Format(Left(Cells(i, 10), 10), "yyyymmdd")
    Next
    For q = 2 To Range("j2").End(xlDown).Row
        t = ActiveWorkbook.Name
        y = val(Mid(t, 5))
        u = Application.Max(Range("M" & q))
        If y = u Then
            If arng Is Nothing Then
                Set arng = Range("M" & q)
            Else
                Set arng = Union(arng, Range("M" & q))
                arng.Select
                a = Selection.Rows(1).Row
                b = Selection.Rows(Selection.Rows.Count).Row
                Range(Cells(a, 1), Cells(b, 11)).Interior.ColorIndex = 6
            End If
        End If
    Next
    p = Range("a1").CurrentRegion.Rows(2).Row
    With Range(Cells(p, 1), Cells(a, 12).Offset(-1, 0))
        .Sort Key1:=Range("d" & p - 1), Order1:=xlAscending, Header:=xlNo
    End With
    Dim ee%, color1%
    Set dd = CreateObject("scripting.dictionary")
    S = Cells(a, 1).Offset(-1, 0).Row()
    For ee = p To S
        dt1 = Format(Cells(ee, 4), "yyyymmdd")
        If dd.Exists(dt1) Then
            Set dd(dt1) = Union(dd(dt1), Cells(ee, 1).Resize(1, 11))
        Else
            Set dd(dt1) = Cells(ee, 1).Resize(1, 11)
        End If
    Next
    For jj = 0 To dd.Count - 1
        dd.items()(jj).Interior.ColorIndex = jj + 37 Mod 56
    Next jj
   
    Set MRG = Range("M:M").Find(y)
    If MRG Is Nothing Then
        Range("a1").CurrentRegion.Select
        With Selection
            .Sort Key1:=Range("d1"), Order1:=xlAscending, Header:=xlYes
        End With
        g = 2
        h = Range("a1").End(xlDown).Row
        Dim e%, color%
        Set d = CreateObject("scripting.dictionary")
        For e = g To h
            dt = Format(Cells(e, 4), "yyyymmdd")
            If d.Exists(dt) Then
                Set d(dt) = Union(d(dt), Cells(e, 1).Resize(1, 11))
            Else
                Set d(dt) = Cells(e, 1).Resize(1, 11)
            End If
        Next
        For j = 0 To d.Count - 1
            d.items()(j).Interior.ColorIndex = j + 37 Mod 56
        Next j
    End If
    End Sub