Что такое "последний отчётный срок"? Какие такие "параметры" приходится корректировать? То "загрузка" то "выгрузка", что там вообще происходит? Да вообще по каждому предложению вопросы.
Sub сэмэсэ()
Dim запрос$, ответ$
URL = "https://api.anysite.com/simple/send?phone=xxxxxxxxxxxx&text=hello+world&username=yyy&password=zzz"
With CreateObject("msxml2.xmlhttp")
.Open "GET", запрос, False 'может вместо get будет post
.send
Do: DoEvents: Loop Until .ReadyState = 4
ответ = .responsetext
End With
Beep
MsgBox ответ
End Sub
Sub uuu()
Dim a()
Dim i&, lr&
'------------
Application.ScreenUpdating = False
a = Sheets("БД").UsedRange.Value
For i = 3 To UBound(a) - 1
On Error Resume Next
With Sheets(a(i, 2))
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For j = 1 To UBound(a, 2)
.Cells(lr, j) = a(i, j)
Next
End With
If Err Then Err.Clear
Next
Application.ScreenUpdating = True
Beep
MsgBox "Приехали!"
End Sub
Sub Глaбол()
Dim a()
Dim j&
'-----------
a = Sheets("Шапка").UsedRange.Rows(21).Value
With CreateObject("Scripting.Dictionary")
For j = 1 To UBound(a, 2)
If a(1, j) <> "" Then .Item(a(1, j)) = ""
Next
a = Sheets("Шапка").UsedRange.Rows(1).Value
For j = 1 To UBound(a, 2)
If a(1, j) <> "" Then
If Not .Exists(a(1, j)) Then
MsgBox "Нет заголовка """ & a(1, j) & """"
Exit Sub
End If
End If
Next
End With
Beep
MsgBox "Всё на месте"
End Sub
Sub uuu()
Dim a()
Dim i&, rw&
'----------------
Application.ScreenUpdating = False
rw = 2
a = Sheets("Выгрузка").UsedRange.Value
With Sheets("Отчет")
For i = 2 To UBound(a)
If a(i, 1) > 0 Then
.Cells(rw, 1) = a(i, 1)
.Cells(rw, 3) = a(i, 3)
rw = rw + 1
End If
Next
.Activate
End With
Application.ScreenUpdating = True
Beep
End Sub
Виктор C написал: Подскажите пожалуйста как задать правильно рабочую область
Сколько будет данных на листе такая и будет рабочая область Становимся в A1 жмякаем Ctr+Shift+End - имеем выделенную рабочую область. Если в неё входят пустые строки то их надо удалить и сохранить файл.
Sub nnn()
Dim a()
Dim fl$
'---------------
fl = ThisWorkbook.Path & "\NO_BOUPR_6617_6617_6617003362661701001_20170221_C90CAFCD7904471D8AF57A83F70E0863.xml"
With CreateObject("MSXML2.DOMDocument")
.Load fl
ReDim a(1 To 7)
a(1) = .SelectSingleNode("//Файл/Документ/СвНП").GetAttribute("ОКПО")
a(2) = .SelectSingleNode("//Файл/Документ/Баланс/Актив").GetAttribute("СумОтч")
a(3) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/МатВнеАкт").GetAttribute("СумОтч")
a(4) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/НеМатФинАкт").GetAttribute("СумОтч")
a(5) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/Запасы").GetAttribute("СумОтч")
a(6) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/ДенежнСр").GetAttribute("СумОтч")
a(7) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/ФинВлож").GetAttribute("СумОтч")
End With
Cells(3, 1).Resize(1, UBound(a)) = a
End Sub
Вариант 2. Если знаем не всё.
Код
Sub uuu()
Dim a()
Dim nd, at
Dim fl$
'---------------
fl = ThisWorkbook.Path & "\NO_BOUPR_6617_6617_6617003362661701001_20170221_C90CAFCD7904471D8AF57A83F70E0863.xml"
With CreateObject("MSXML2.DOMDocument")
.Load fl
ReDim a(1 To 7)
For Each nd In .getElementsByTagName("*")
If nd.NodeName = "СвНП" Then
a(1) = nd.GetAttribute("ОКПО")
Else
For Each at In nd.Attributes
If at.Name = "КодСтроки" Then
Select Case at.Value
Case "1600": a(2) = nd.GetAttribute("СумОтч")
Case "1150": a(3) = nd.GetAttribute("СумОтч")
Case "1170": a(4) = nd.GetAttribute("СумОтч")
Case "1210": a(5) = nd.GetAttribute("СумОтч")
Case "1250": a(6) = nd.GetAttribute("СумОтч")
Case "1260": a(7) = nd.GetAttribute("СумОтч")
End Select
End If
Next
End If
Next
End With
Cells(3, 1).Resize(1, UBound(a)) = a
End Sub
Sub uuu()
Dim a()
Dim i&
Dim sd As Object
'----------------------
a = Sheets(2).UsedRange.Value
Set sd = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a)
sd.Item(a(i, 1)) = a(i, 2)
Next
With Sheets(1)
a = .UsedRange.Value
For i = 2 To UBound(a)
If sd.Exists(a(i, 1)) Then
a(i, 4) = sd.Item(a(i, 1))
End If
Next
.Cells(1, 1).Resize(UBound(a), UBound(a, 2)) = a
End With
Beep
MsgBox "Готово!"
End Sub
tod2020, тут тема есть про скачивание файла через IE - не Вы, случайно? Точно так же человек отстаивает свою позицию. Ответ на вопрос можно ли в словаре искать неточное совпадение - нет. Это всё равно будет цикл. Для ускорения поиска по массиву, как уже говорилось, искомое значение берём в переменную и, если совпадение будет одно, то используем exit for после того, как нашли значение.
Код
s = Cells(9, 3)
For i = 1 To UBound(a)
If a(i, 1) Like s Then
MsgBox a(i, 2)
Exit For
End If
Next
Sub uuu()
Dim a()
Dim i&
'-----------
a = Range("Table1").Value
For i = 1 To UBound(a)
If a(i, 1) Like Cells(9, 3) Then
Beep
MsgBox a(i, 1)
End If
Next
End Sub