По коду макроса больше не появляется статус 200. Получается : status : 429 : Long Примерно понимая, нужно добавить заголовки или куки прописать (это не точно). Подскажите что дописать в макрос чтобы появился статус 200 на сайт https://fgis.gost.ru/fundmetrology/cm/results
ПС:Разобрался)) Запрос поиска был на 500 значений (похоже порезали с этого года). Выставил на 100 и заработало))))
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, For ? Do Wile
ПС Нашел
Код
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
нажимаю на 4 (ЛБ2). Нажимаю на 1(ЛБ1). выделение 4 сбрасывается нажиаю снова на 4. потом нажимаю на 1 выделение не сбрасывется. значение то не поменялось.
Не нашел моего примера, есть только сравнение таблиц при одинаковом значении.
На форме имеется два листбокса. На верхнем (Л1) то что уже есть, а на нижнем (нужно сделать) то что осталось, т.е (Л2-Л1). Не получается сформировать нижний листбокс.
Код
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
ругается на "Товар[тип]" Вы ввели для этой функции аргументов: слишком много .
Большое спасибо за помощь перевел на рус формулы
не получается получить цену за второй и третий товар в списке.
мне бы что-то похожее (вместо вопросов надо найти строку СУММПРОИЗВ(('D:\[F1.xlsm]СписТов'!C?&" "&'D:\[F1.xlsm]СписТов'!D?=СЖПРОБЕЛЫ( ПСТР(ПОДСТАВИТЬ(";"&C?;";";ПОВТОР(" ";99));СТОЛБЕЦ(B:B)*99;99)))*'D:\[F1.xlsm]СписТов'!E?)
Добрый день. Имеется два файла (F1, F2). В первом имеется общи список товаров, а во втором "объединеные группы товаров". В каждом файле по одной умной таблице. Во втором файле есть второй столбец со ссылками (привязанными) на первый файл. Как вытащить формулой (допускатется создать самому) во второй файл цену товара на каждый предмет. Во так выглядит код ссылки во втором файле