Sub selectData()
              
     '(если только это уже не было проделано ранее, то)
     'Перед запуском в редакторе VB в меню Tools\References установить ссылку (включить галку)
     'на библиотеку "Microsoft ActiveX Data Objects ... Library", где ... - номер версии.
     'Можно выбрать любой максимальный (6.0, 2.8, 2.5...) из того, что установлено на компьютере.
              
     Dim cnn As New ADODB.Connection
     Dim rst As New ADODB.Recordset
              
     Range("E2:M" & Rows.Count).ClearContents
      
     cnn.Open _
     "Provider=Microsoft.ACE.OLEDB.12.0;" & _
     "Data Source=" & ThisWorkbook.FullName & ";" & _
     "Extended Properties='Excel 12.0;HDR=Yes'"
              
     '1. получаем все уникальные времена начала и окончания звонков
     'одним общим отсортированным столбцом
     rst.Open _
     "SELECT Begins FROM [Лист2$A:C] UNION " & _
     "SELECT Ends   FROM [Лист2$A:C] " & _
     "ORDER BY 1 DESC" _
     , cnn
      
     [Лист2!E2].CopyFromRecordset rst
     rst.Close
      
     '2. делаем искусственный сдвиг на одну запись,
     'чтобы далее совместить в одной строке начало и окончание
     'уникального интервала проверки
     rst.Open _
     "SELECT Begins2        FROM [Лист2$E:E] UNION " & _
     "SELECT MAX(Begins2)+1 FROM [Лист2$E:E]  " & _
     "ORDER BY 1 DESC" _
     , cnn
      
     [Лист2!F2].CopyFromRecordset rst
     rst.Close
      
     '3. окончательно формируем все нужные уникальные интервалы времени для проверки
     rst.Open _
     "SELECT * FROM [Лист2$E:F] " & _
     "WHERE Begins2 IS NOT NULL " & _
     "  AND Ends2   < (SELECT MAX(Begins2)+1 FROM [Лист2$E:E]) " & _
     "ORDER BY 1, 2" _
     , cnn
      
     [Лист2!H2].CopyFromRecordset rst
     rst.Close
      
     '4. для каждого уникального интервала считаем звонки (линии),
     'для которых этот уникальный интервал полностью содержится
     'внутри времени звонка
     rst.Open _
     "SELECT Begins3, Ends3, " & _
     "      (SELECT COUNT(*) FROM [Лист2$A:C] " & _
     "       WHERE Begins <= Begins3 AND Ends >= Ends3) " & _
     "FROM [Лист2$H:I] " & _
     "WHERE Begins3 IS NOT NULL " & _
     "ORDER BY 1, 2" _
     , cnn
      
     [Лист2!K2].CopyFromRecordset rst
     rst.Close
      
     Range("E2:L" & Rows.Count).NumberFormat = "h:mm:ss"
                    
     Set rst = Nothing
     Set cnn = Nothing
End Sub