Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   If Target.Column > 4 Then
   Dim i As Long, c As Long, iSum1 As Double, iSum2 As Double
   For Each iCell In Target
   If iCell <> "" And iCell.Interior.ColorIndex <> 4 Then
   Select Case iCell.Column
      Case Is < 11: c = 6
      Case Is < 19: c = 14
      Case Is < 27: c = 22
      Case Is < 35: c = 30
      End Select
   For i = c - iCell.Column Mod 2 To 36 - iCell.Column Mod 2 Step 2
   Select Case i
   Case 11, 12, 19, 20, 27, 28, 35, 36
   If iSum2 = Empty Then
   Cells(iCell.Row, i) = iSum1
   Else
   Cells(iCell.Row, i) = iSum1 & "/" & iSum2
   End If
   Case Else
   aa = Split(Cells(iCell.Row, i), "/")
   On Error Resume Next
   iSum1 = iSum1 + aa(0) * 1
   On Error Resume Next
   iSum2 = iSum2 + aa(1) * 1
   End Select
   Next i
   End If
   Next
   End If
   Application.EnableEvents = True
   End Sub