Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Использовать URL из ячейки
 
Подскажите, пожалуйста. Существует простой код, который вытаскивает некоторые данные с сайта. Сейчас ссылка URL прописана в коде. Но хотелось бы, чтобы ссылка была взята из ячейки ( D4,лист СВОДНАЯ ТАБЛИЦА), где сейчас существует в виде гиперссылки.  

Код
Sub Датааукциона()
' Датааукциона макрос
'
    Sheets("Тех.лист).Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://zakupki.gov.ru/epz/order/notice/ea44/view/common-info.html?regNumber=0373200032218000946"; _
        , Destination:=Range("Тех.лист!$A$1"))
        .Name = "common-info.html?regNumber=0373200032218000946"
    End With
    Sheets("Тех.лист").Select
    Range("B37").Select
    Selection.Copy
    Sheets("СВОДНАЯ ТАБЛИЦА").Select
    Range("AH4").Select
    ActiveSheet.Paste
End Sub
Изменено: AN|\|A - 18 Июл 2018 11:43:41
 
Annaannaannaanna, исправьте сообщение и заключите свой код в теги(на панели <...>)
Код
    URL = Sheets("СВОДНАЯ ТАБЛИЦА").Range("D4")
    Set QueryTables = Sheets("Тех.лист").QueryTables
    For Each qt In QueryTables
        If InStr(qt.Name, "zakupki.gov.ru") Then qt.Delete
    Next
    Sheets("Тех.лист").Cells.Clear
    With Sheets("Тех.лист").QueryTables.Add(Connection:="URL;" & URL & "", Destination:=Sheets("Тех.лист").Range("$A$1"))
        .Name = "zakupki.gov.ru"
        .WebFormatting = xlWebFormattingNone
        .Refresh BackgroundQuery:=True
    End With
 
И ник приведите в порядок.
 
Jungl, большое спасибо, но код все Равно не отработал  :(

Файлы удалены: превышение допустимого размера вложения [МОДЕРАТОР]
Изменено: AN|\|A - 18 Июл 2018 12:23:36
 
Цитата
AN|\|A написал:
код все Равно не отработал
советую сравнить код в форуме и код, который у Вас в VBA перенесся. Особое внимание - имени листа в кавычках в той самой желтой строке на скрине.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Jungl, Прошу прощения, сначала неправильно отправила.  Пишет " неверный адрес ". Не подскажите?

Дмитрий(The_Prist) Щербаков, прошу прощения, не те скрины отправила сначала.
 
Jungl, ваш код отлично работает, если в тех ячейках напрямую прописан адрес сайта. Но адрес там содержится адрес только в гиперссылках.  Вся сложность у меня именно с извлечением гиперссылок.  Но в любом случае спасибо за помощь
 
Код
Function Get_Hyperlink_Address(ByVal rCell As Range) As String
    Dim s As String
    If rCell.Hyperlinks.Count = 0 Then
        If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then
            Get_Hyperlink_Address = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13)
        Else
            Get_Hyperlink_Address = "В ячейке нет гиперссылки!"
        End If
    Else
        s = rCell.Hyperlinks(1).SubAddress
        If s <> "" Then s = "#" & rCell.Hyperlinks(1).SubAddress
        Get_Hyperlink_Address = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & s
    End If
End Function
Код
=Get_Hyperlink_Address(B1)
отсюда

то есть вместо вашего URL пишите
Get_Hyperlink_Address(A1)
Изменено: VideoAlex - 18 Июл 2018 13:27:26
 
VideoAlex, Спасибо большое!
Страницы: 1
Читают тему (гостей: 1)
Наверх