繰り返し値に基づく色の行 - excel vba

Question

私はチームの旅行計画のために毎週受け取るExcelファイルを簡略化しようとしています。

チームメンバーの名前、フライト番号、到着時刻があります。

私はチームメンバーに異なる飛行をしていることがあります。レンタカーの手配が簡単にできるように、いつ誰が到着するかを視覚的に確認したい。あるグループが1:06に到着した場合、それらを一緒に強調表示し、6:55に別のグループを強調表示します - それらを強調表示します。 15種類の飛行計画があります。私は現在、一般的なものを識別するために条件付き書式を使用していますが、私は50人のために毎週これを実行するので、実行するためにvbaモジュールに通すことは便利でしょう。 （私はすでにいくつかの列/行を再フォーマットするモジュールを持っています）。

私は繰り返しコード識別子とこれを私の主なリソースとして見てきました Compare Dates/Timesしかしこれまでのところ運がありません。私は今何をすべきかの

画像： highlight

Answer 1

私がコード化されている方法は、「フライト＃」カラムのユニークな値が計算され、データがテーブルにフォーマットされていることです。データは、これらの値によって順次フィルタリングされ、行は、（変更可能な）所定のパレットから色付けされる。 ******

Sub FormatDuplicateRows() 

    Dim wsFlight As Worksheet: Set wsFlight = Worksheets("Flights") 

    On Error Resume Next 
    If Not wsFlight.ListObjects("Flights") Is Nothing Then wsFlight.ListObjects("Flights").Unlist 
    On Error GoTo 0 

    wsFlight.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).Name = "Flights" 
    Dim tblFlight As ListObject: Set tblFlight = wsFlight.ListObjects("Flights") 

    Dim Fld As Long: Fld = tblFlight.ListColumns("Flight #").Range.Column 

    Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary") 
    For Each Cell In tblFlight.ListColumns("Flight #").DataBodyRange 
     If Not Dict.Exists(Cell.Value) Then Dict.Add Cell.Value, Cell.Address 
    Next 

    Dim Colours() As String: Colours = Split("&HD9E9FD,&HF3EEDB,&HECE0E5,&HDDF1EA,&HDCDDF2,&HCCFFFF", ",") 
    Dim i As Long: i = 0 
    With tblFlight 
     .TableStyle = "TableStyleLight1" 
     .ShowTableStyleRowStripes = False 
     For Each Value In Dict.Keys 
      .Range.AutoFilter Field:=Fld, Criteria1:=Value 
      .DataBodyRange.SpecialCells(xlCellTypeVisible).Interior.Color = Colours(i) 
      i = IIf(i = UBound(Colours), 0, i + 1) 
     Next Value 
     .Range.AutoFilter Field:=Fld 
    End With 

End Sub 

あなたはあなたの要件にパレットを変更することができ、パレットは、オートリピートは、一度、すべての色が

********* UPDATE一度使用されています****

は、アレイの色値を取得する私は、次の関数

Public Function GetColour(rngSrc As Range) As String 
    GetColour = "&H" & Application.WorksheetFunction.Dec2Hex(rngSrc.Interior.Color) 
End Function 

を符号化されたExcelワークブックに、私は「A2」に式= GetColour（「A1」）を配置しました塗りつぶしの色を変更しました。行1に沿ったいくつかのセルをドラッグして式をドラッグドロップして、必要な塗りつぶし色の16進値を得ました。