1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
| With ThisWorkbook.sheets("Ëèñò3")
'Íèæåñëåäóþùåå ïðèñâîåíèå ññûëêè íà îáúåêò â äàííîì ìàêðîñå íå èñïîëüçóåòñÿ.
Set CStart = .[A1] 'ðååñòðîâûå íîìåðà çàêàçà ñ ëèñòà ¹ 3 (ÿ÷åéêà À5)
'For i = 1 To 100
For i = 1 To .UsedRange.End(xlDown).Row + 1000
If Val(Right(.Cells(i, 1), 19)) > 1 Then
' ôîðìèðóåì ññûëêó
' Ñàéò è ïîèñêîâûé çàïðîñ ê ñàéòó.
'Ñèíòàêñèñ ïîñòðîåíèÿ çàïðîñà îïðåäåëÿåòñÿ ïîèñêîâîé ìàøèíîé ñàéòà
URL$ = "http://www.bus.gov.ru/public/register/agencyInfo.html?agency=" & Right(ThisWorkbook.sheets("Ëèñò3").Cells(i, 1), 19)
'- ïîñëå ðàâíî äîëæíî âñòàâëÿòüñÿ ïîëå ñ ðååñòðîâûì íîìåðîì çàêàçà (À4) è òàê ïî ïîðÿäêó, ïîòîì íàäî ÷òîáû êîïèðîâàëñÿ òåêñò ññûëêè íà çàêàç
Set ra = GetQueryRange(URL$, "2")
' ïåðåáèðàÿ ÿ÷åéêè òàáëèöû-ðåçóëüòàòà, âûâîäèì ñïèñîê òåì â îêíî Immediate
If Not ra Is Nothing Then
Set c = ra.Columns(1).Find("ÈÍÍ*", , xlValues, xlWhole)
If Not c Is Nothing Then
n = n + 1: Debug.Print "Òåìà ¹" & n, oCell.Text
Debug.Print c & c.Offset(, 1): Debug.Print
' MsgBox c & c.Offset(, 1)
End If
End If
'Next oCell
'Êîïèðóåì ÿ÷åéêó ñî ññûëêîé ñ ëèñòà "tmpWQ1"
ra.Range("B11").Copy
'sheets ("tmpWQ1"), Range("b12").Copy
.Activate
'Range(Sheets(3).Cells(n, 1), Sheets(3).Cells(n, 9)).Copy Sheets(1).Range("J2" & yDest)
'yDest = yDest + 1 '÷åðåç 1 ñòðîêó
'With ThisWorkbook.Sheets("Ëèñò3")
With sheets("Ëèñò1").Cells(1 + i, "B")
' With Sheets(3).Cells(1 + i, [C,C])
' Range(Sheets(3) .Cells(n, 1)).Copy Sheets(3).Range("J2" & yDest)
'yDest = yDest + 1 '÷åðåç 1 ñòðîêó
.Select
' âñòàâëÿåì ñêîïèðîâàííóþ ÿ÷åéêó íà "Ëèñò3"
ActiveSheet.Paste
' Ôîðìàòèðîâàíèå
' .HorizontalAlignment = xlLeft
.WrapText = False
' Âcòàâëÿåìûé âèäèìûé òåêñò ññûëêè
' .Value = ra.Range("J2").c.Offset(, 1)
End With
ra.Range("B12").Copy
'sheets ("tmpWQ1"), Range("b12").Copy
.Activate
'Range(Sheets(3).Cells(n, 1), Sheets(3).Cells(n, 9)).Copy Sheets(1).Range("J2" & yDest)
'yDest = yDest + 1 '÷åðåç 1 ñòðîêó
'With ThisWorkbook.Sheets("Ëèñò3")
With sheets("Ëèñò1").Cells(1 + i, "C")
' With Sheets(3).Cells(1 + i, [C,C])
' Range(Sheets(3) .Cells(n, 1)).Copy Sheets(3).Range("J2" & yDest)
'yDest = yDest + 1 '÷åðåç 1 ñòðîêó
.Select
' âñòàâëÿåì ñêîïèðîâàííóþ ÿ÷åéêó íà "Ëèñò3"
ActiveSheet.Paste
' Ôîðìàòèðîâàíèå
' .HorizontalAlignment = xlLeft
.WrapText = False
' Âcòàâëÿåìûé âèäèìûé òåêñò ññûëêè
' .Value = ra.Range("J2").c.Offset(, 1)
End With
End If
Next i
End With
End Sub |
