­ã´£³¡ªL

Sub ¾l¼Æµn¿ý()
Dim xS As Worksheet, R&, Arr, Brr, A
For Each xS In Sheets(Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8"))
    R = xS.[b65536].End(xlUp).Row - 1
    Arr = xS.[m2:ab2].Resize(R)
    ReDim Brr(1 To R, 1 To 7)
    For i = 1 To R
    For j = 1 To 7
        For Each A In Split(Arr(i, j + 9), ",")
            Brr(i, j) = Brr(i, j) & "," & Format((Arr(i, j) + Val(A)) Mod 49, "00;;49")
        Next A
        Brr(i, j) = Mid(Brr(i, j), 2)
    Next j
    Next i
    xS.[d2].Resize(R, 7) = Brr
Next xS
End Sub

­ã´£³¡ªL

Sub ¼Ð¥Ü©³¦â()
Dim xS As Worksheet, R&, Arr, A, xD, xU As Range, N&
Set xD = CreateObject("Scripting.Dictionary")
For Each xS In Sheets(Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8"))
    R = xS.[b65536].End(xlUp).Row
    xS.[d2].Resize(R, 7).Interior.ColorIndex = xlNone
    Set xU = xS.[c2]
    For j = 1 To 7:   xD(Val(xS.Cells(R, j + 12))) = 1: Next j
    Arr = xS.[d1].Resize(R, 7)
    For i = 2 To R:  For j = 1 To 7
        For Each A In Split(Arr(i, j), ",")
            If xD(Val(A)) > 0 Then Set xU = Union(xS.Cells(i, j + 3), xU): Exit For
        Next A
    Next j: Next i
    '-------------------------------
    R = xS.[a65536].End(xlUp).Row
    xS.[a4].Resize(R).Interior.ColorIndex = xlNone
    Arr = xS.[a1].Resize(R)
    For i = 4 To R
        If xD(Val(Arr(i, 1))) > 0 Then Set xU = Union(xS.Cells(i, 1), xU)
    Next i
    xU.Interior.ColorIndex = 8
    xS.[c2].Interior.ColorIndex = xlNone
    xD.RemoveAll: N = 0
Next xS
End Sub

­ã´£³¡ªL

¦^´_ 45# ziv976688

1)
Brr(i, j) = Brr(i, j) & "," & Format(ABS((Arr(i, j) - Val(A)) Mod 49), "00;;49")

2)
V= (Arr(i, j) - Val(A)) Mod 49
IF V<0 THEN V=V+49
Brr(i, j) = Brr(i, j) & "," & Format(V, "00;;49")