Sub test()
Dim Arr, xD, T%, i&, j&, Tm
Tm = Timer
Set xD = CreateObject("Scripting.Dictionary")
R = Columns("M:DF").Find("*", , , , , 2).Row
Arr = Range("M1:DF" & R)
For j = 1 To UBound(Arr, 2) Step 2
For i = 2 To UBound(Arr)
T = Arr(i, j): If T = 0 Then GoTo 98
xD(T & "/1") = xD(T & "/1") + 1
xD(T & "/2") = xD(T & "/2") + Arr(i, j + 1)
Next i
98: Next j
Arr = Range([C1], [B65536].End(3))
For i = 2 To UBound(Arr)
For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
Next
[c2].Resize(UBound(Arr) - 1, 2) = Arr
MsgBox Timer - Tm
End Sub