Sub Аршин()
Dim XMLHTTP As Object
Dim URL$, Txt$

URL = "https://fgis.gost.ru/fundmetrology/cm/results/1-34756749"
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")

XMLHTTP.Open "GET", URL, False
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.182 Safari/537.36"
XMLHTTP.SEND
If XMLHTTP.Status = 200 Then
    Txt = XMLHTTP.responseText
       
    MsgBox Txt 

Else
    MsgBox "Отсутствует соединение..."
End If
Set XMLHTTP = Nothing
End Sub

Function СтандОтклон1(Arr)
    Dim x, aCnt&, aSum#, aAver#, tmp#
    For Each x In Arr
        aSum = aSum + x 'вычисляем сумму элементов массива
        aCnt = aCnt + 1 'вычисляем кол-во элементов
    Next x
    aAver = aSum / aCnt 'среднее значение
    For Each x In Arr
        tmp = tmp + (x - aAver) ^ 2 'вычисляем сумму квадратов разницы элементов массива и среднего значения
    Next x
    СтандОтклон1 = Sqr(tmp / (aCnt * (aCnt - 1))) 'вычисляем СТАНДОТКЛОН.Г()
End Function

If Not c Is Nothing Then
    firstResult = c.Address
    Do
      c.Font.Bold = True
      Set c = .FindNext(c)
      If c Is Nothing Then Exit Do
    Loop While c.Address <> firstResult
  End If

Option Explicit

'Л1
Dim ЛЛ1 As Worksheet ' Лист
Dim ТЛ1 As ListObject ' Таблица
Dim СЛ1 As ListRow ' Строка

'Л2
Dim ЛЛ2 As Worksheet ' Лист
Dim ТЛ2 As ListObject ' Таблица
Dim СЛ2 As ListRow ' Строка

Sub Добавить()
    Add.Show
End Sub
Sub СформироватьСписки()
    
    Dim a As Range
    Dim b As Range
    
    Set ЛЛ1 = ThisWorkbook.Worksheets("Л1")
    Set ТЛ1 = ЛЛ1.ListObjects("тб_Мое")
    Set ЛЛ2 = ThisWorkbook.Worksheets("Л2")
    Set ТЛ2 = ЛЛ2.ListObjects("тб_Все")
    ' очистка
    Add.lb_all.Clear
    Add.lb_add.Clear
    Add.lb_all.ColumnWidths = "200,700"
    Add.lb_add.ColumnWidths = "200,700"
    ' заполнение верха Листбокса
    For Each СЛ1 In ТЛ1.ListRows
        Add.lb_all.AddItem СЛ1.Range(1)
        Add.lb_all.List(Add.lb_all.ListCount - 1, 1) = СЛ1.Range(2)
    Next СЛ1
    ------------------------------------------------------------------------------- Тут загвоска
    ' заполенние низа Листбокса
    
    For Each СЛ2 In ТЛ2.ListRows
    Set a = ТЛ2.ListColumns.Item(2).Range.Find(СЛ2.Range(2), , , xlWhole)
       
            For Each СЛ1 In ТЛ1.ListRows
            Set b = ТЛ1.ListColumns.Item(2).Range.Find(СЛ1.Range(2), , , xlWhole)
                If Not a Like b Then   ' если не найден артикуул
                    Add.lb_add.AddItem СЛ2.Range(1)
                    Add.lb_add.List(Add.lb_add.ListCount - 1, 1) = СЛ2.Range(2)
                ElseIf СЛ1.Range(2) Like СЛ2.Range(2) Then
                    Exit For
                End If
            
            Next СЛ1
    Next СЛ2

  ---------------------------------------------------------------------------
End Sub

=СУММЕСЛИ(F1.xlsm!Товар[цена];F1.xlsm!Товар[предмет];СЖПРОБЕЛЫ(ЛЕВСИМВ(ПОДСТАВИТЬ(СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(";"&
[@Предметы];";";ПОВТОР(" ";99));СТОЛБЕЦ(A:A)*99;99));" ";
ПОВТОР(" ";"99"));99));F1.xlsm!Товар[тип];СЖПРОБЕЛЫ(ПРАВСИМВ(ПОДСТАВИТЬ(СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(";"&
[@Предметы];";";ПОВТОР(" ";99));СТОЛБЕЦ(A:A)*99;99));" ";ПОВТОР(" ";"99"));99)))

='D:\[F1.xlsm]СписТов'!B2&" "&'D:\[F1.xlsm]СписТов'!C2&"; "
&'D:\[F1.xlsm]СписТов'!B3&" "&'D:\[F1.xlsm]СписТов'!C3&"; "
&'D:\[F1.xlsm]СписТов'!B6&" "&'D:\[F1.xlsm]СписТов'!C6