--- Revision None
+++ Revision 346132313562
@@ -0,0 +1,115 @@
+Sub Swap(a, x, y)
+    Dim i
+    Dim t
+    ReDim t(LBound(a, 1) To UBound(a, 1))
+    For i = LBound(a, 1) To UBound(a, 1)
+        t(i) = a(i, x)
+    Next
+    For i = LBound(a, 1) To UBound(a, 1)
+        a(i, x) = a(i, y)
+    Next
+    For i = LBound(a, 1) To UBound(a, 1)
+        a(i, y) = t(i)
+    Next
+End Sub
+
+Sub Sort(a, row, keys As Scripting.Dictionary)
+    Dim i
+    Dim j
+    For i = LBound(a, 1) To UBound(a, 1) - 1
+        For j = LBound(a, 1) To UBound(a, 1) - 1
+            If keys(a(row, j)) < keys(a(row, j + 1)) Then
+                Call Swap(a, j, j + 1)
+            End If
+        Next
+    Next
+End Sub
+
+Function GetSheet(rowNum As Long) As Excel.Worksheet
+    Set GetSheet = Excel.Worksheets(rowNum + 1)
+End Function
+
+Function GetRels_2(sh As Excel.Worksheet, c As String) As Scripting.Dictionary
+    Dim r As Scripting.Dictionary
+    Set r = New Scripting.Dictionary
+    Dim j As Long
+    Dim i As Excel.Range
+    For Each i In sh.Range("B1:D1").Columns
+        If i.Value = c Then
+            j = i.Column
+            Exit For
+        End If
+    Next
+    For Each i In sh.Range("A2:D4").Rows
+        Call r.Add(i.Columns(1).Value, i.Columns(j))
+    Next
+    Set GetRels_2 = r
+End Function
+
+Function GetRels(rowNum As Long, c As String) As Scripting.Dictionary
+    Set GetRels = GetRels_2(GetSheet(rowNum), c)
+End Function
+
+Function GetColor(r As Long) As Long
+    If r = 5 Then
+        GetColor = RGB(255, 0, 0)
+    ElseIf r = 3 Then
+        GetColor = RGB(255, 128, 128)
+    ElseIf r = 1 Then
+        GetColor = RGB(255, 192, 192)
+    ElseIf r = 0 Then
+        GetColor = RGB(255, 224, 224)
+    Else
+        Call Err.Raise(1, "invalid relative")
+    End If
+End Function
+
+Function GetColors_2(rels As Scripting.Dictionary) As Scripting.Dictionary
+    Dim c As Scripting.Dictionary
+    Set c = New Scripting.Dictionary
+    Dim i
+    For Each i In rels.keys
+        Call c.Add(i, GetColor(rels(i)))
+    Next
+    Set GetColors_2 = c
+End Function
+
+Function GetColors(rowNum As Long, c As String) As Scripting.Dictionary
+    Set GetColors = GetColors_2(GetRels(rowNum, c))
+End Function
+
+Sub Main()
+    Dim rowNum As Long
+    Dim char1 As String
+    rowNum = Excel.Selection.row
+    char1 = Excel.Selection.Value
+    
+    ' Sort
+    Dim v As Variant
+    Dim sh1 As Excel.Worksheet
+    Dim range1 As Excel.Range
+    Set sh1 = Excel.Worksheets(1)
+    Set range1 = sh1.Range("A1:C3")
+    v = range1.Value
+    Call Sort(v, 1, GetRels(rowNum, char1))
+    range1.Value = v
+    
+    ' Coloring
+    Dim c As Scripting.Dictionary
+    Dim i As Excel.Range
+    Dim j As Excel.Range
+    Dim colNum As Long
+    colNum = 1
+    For Each i In range1.Rows(rowNum).Columns
+        If i.Value = char1 Then
+            Exit For
+        End If
+        colNum = colNum + 1
+    Next
+    For Each i In range1.Rows
+        Set c = GetColors(i.row, i.Columns(colNum).Value)
+        For Each j In i.Columns
+            j.Interior.Color = c(j.Value)
+        Next
+    Next
+End Sub