Sub jjj()
' обработка телефонов в столбце B НАЧАТА
     Set datas = [b2]
     Set rtemp = datas: With rtemp: Set lcl = .Offset(Rows.Count - .Row).End(xlUp): Set rtemp = Range(.Address, IIf(lcl.Row > .Row, lcl, .Address)): End With: Set teltocheck = rtemp
      
     Set rtemp = [d2]: With rtemp: Set lcl = .Offset(Rows.Count - .Row).End(xlUp): Set rtemp = Range(.Address, IIf(lcl.Row > .Row, lcl, .Address)): End With: Set rngd = rtemp
     Set rtemp = [f2]: With rtemp: Set lcl = .Offset(Rows.Count - .Row).End(xlUp): Set rtemp = Range(.Address, IIf(lcl.Row > .Row, lcl, .Address)): End With: Set rngf = rtemp
     Set rtemp = [h2]: With rtemp: Set lcl = .Offset(Rows.Count - .Row).End(xlUp): Set rtemp = Range(.Address, IIf(lcl.Row > .Row, lcl, .Address)): End With: Set rngh = rtemp
     Set rtemp = [j2]: With rtemp: Set lcl = .Offset(Rows.Count - .Row).End(xlUp): Set rtemp = Range(.Address, IIf(lcl.Row > .Row, lcl, .Address)): End With: Set rngj = rtemp
     Set rtemp = [l2]: With rtemp: Set lcl = .Offset(Rows.Count - .Row).End(xlUp): Set rtemp = Range(.Address, IIf(lcl.Row > .Row, lcl, .Address)): End With: Set rngl = rtemp
     Set rtemp = [n2]: With rtemp: Set lcl = .Offset(Rows.Count - .Row).End(xlUp): Set rtemp = Range(.Address, IIf(lcl.Row > .Row, lcl, .Address)): End With: Set rngn = rtemp
     Set rtemp = Nothing
     Set teltodel = Application.Union(rngd, rngf, rngh, rngj, rngl, rngn)
     Set rngf = Nothing: Set rngh = Nothing: Set rngj = Nothing: Set rngn = Nothing
      
     Set dicteltocheck = CreateObject("Scripting.Dictionary")
     Set dicteltodel = CreateObject("Scripting.Dictionary")
      
     For Each cl In teltocheck
         If Len(cl.Value) Then dicteltocheck(cl.Value) = cl.Value
     Next cl
     For Each cl In teltodel
         If Len(cl.Value) Then dicteltodel(cl.Value) = cl.Value
     Next cl
     Set teltodel = Nothing
      
     For Each dd In dicteltodel
         If dicteltocheck.Exists(dd) Then dicteltocheck.Remove dd: Debug.Print dd
     Next dd
      
     teltocheck.ClearContents
     Set teltocheck = Nothing
     i = 0
     For Each dc In dicteltocheck
         datas.Offset(i).Value = dc
         i = i + 1
     Next dc
     dicteltocheck.RemoveAll
     dicteltodel.RemoveAll
' обработка телефонов в столбце B окончена
' обработка телефонов в столбце D НАЧАТА
     Set datas = rngd.Resize(1, 1)
     Set teltocheck = rngd
     Set teltodel = rngl
      
     For Each cl In teltocheck
         If Len(cl.Value) Then dicteltocheck(cl.Value) = cl.Value
     Next cl
     For Each cl In teltodel
         If Len(cl.Value) Then dicteltodel(cl.Value) = cl.Value
     Next cl
     Set teltodel = Nothing
      
     For Each dd In dicteltodel
         If dicteltocheck.Exists(dd) Then dicteltocheck.Remove dd
     Next dd
     Debug.Print
      
     teltocheck.ClearContents
     Set teltocheck = Nothing
     i = 0
     For Each dc In dicteltocheck
         datas.Offset(i).Value = dc
         i = i + 1
     Next dc
     dicteltocheck.RemoveAll
     dicteltodel.RemoveAll
' обработка телефонов в столбце D окончена
End Sub