Импорт данных Excel в конкретную ячейку

Question

Я хотел бы перечислить устройства и поставить их цены рядом с ними.

Моя цель - проверять различные сайты каждую неделю и отслеживать тенденции.

Это проект хобби, я знаю, что есть сайты, которые уже делают это.

Например:

Device | URL Site 1 | Site 1 | URL Site 2 | Site 2 
Device a | http://... | €40,00 | http://... | €45,00 
Device b | http://... | €28,00 | http://... | €30,50 

вручную, это много работы (проверка каждую неделю), так что я думал, Macro в Excel поможет. Дело в том, что я хотел бы поместить данные в одну ячейку, а excel распознает только таблицы. Решение: просмотреть исходный код, прочитать цену, экспортировать цену в определенную ячейку.

Я думаю, что это все возможно в Excel, но я не могу понять, как читать цену или другие данные и как поместить их в одну конкретную ячейку. Могу ли я указать координаты в исходном коде или есть более эффективный способ мышления?

Заранее спасибо, все советы и решения приветствуются!

Answer 1

Прежде всего, вам нужно выяснить, как работает сайт. Для page вы спросили, я сделал следующее:

• Открыта http://www.mediamarkt.de страницы в Chrome.
• Напечатано BOSCH WTW 85230 в окне поиска, появился список предложений.
• Напечатано F12 Чтобы открыть инструменты разработчика и щелкните вкладку Сеть.
• Каждый раз, когда я печатал, новый запрос появился (см желтые области):

• Нажал запрос изучить общую информацию:

Вы можете видеть, что он использует метод GET и некоторые параметры, включая url-encoded prod uct name.

• Нажал вкладку Response для изучения данных, возвращающиеся с сервера:

Вы можете увидеть это обычный JSON, полное содержание выглядит следующим образом:

{"suggestions":[{"attributes":{"energyefficiencyclass":"A++","modelnumber":"2004975","availabilityindicator":"10","customerrating":"0.00000","ImageUrl":"http://pics.redblue.de/artikelid/DE/2004975/CHECK","collection":"shop","id":"MediaDEdece2358813","currentprice":"444.00","availabilitytext":"Lieferung in 11-12 Werktagen"},"hitCount":0,"image":"http://pics.redblue.de/artikelid/DE/2004975/CHECK","name":"BOSCH WTW 85230 Kondensationstrockner mit Warmepumpentechnologie (8 kg, A++)","priority":9775,"searchParams":"/Search.ff?query=BOSCH+WTW+85230+Kondensationstrockner+mit+W%C3%A4rmepumpentechnologie+%288+kg%2C+A+%2B+%2B+%29\u0026channel=mmdede","type":"productName"}]} 

Здесь вы найдете "currentprice":"444.00" недвижимость по цене.

• Упрощенный запрос, выбрасывая некоторые дополнительные параметры, оказалось, что такой же ответ в формате JSON можно получить по адресу http://www.mediamarkt.de/FACT-Finder/Suggest.ff?channel=mmdede&query=BOSCH+WTW+85230
• Эти данные достаточно было построен некоторый код, при условии, что первый столбец, предназначенный для продуктов :

Option Explicit 

Sub TestMediaMarkt() 

    Dim oRange As Range 
    Dim aResult() As String 
    Dim i As Long 
    Dim sURL As String 
    Dim sRespText As String 

    ' set source range with product names from column A 
    Set oRange = ThisWorkbook.Worksheets(1).Range("A1:A3") 
    ' create one column array the same size 
    ReDim aResult(1 To oRange.Rows.Count, 1 To 1) 
    ' loop rows one by one, make XHR for each product 
    For i = 1 To oRange.Rows.Count 
     ' build up URL 
     sURL = "http://www.mediamarkt.de/FACT-Finder/Suggest.ff?channel=mmdede&query=" & EncodeUriComponent(oRange.Cells(i, 1).Value) 
     ' retrieve HTML content 
     With CreateObject("MSXML2.XMLHTTP") 
      .Open "GET", sURL, False 
      .Send 
      sRespText = .responseText 
     End With 
     ' regular expression for price property 
     With CreateObject("VBScript.RegExp") 
      .Global = True 
      .MultiLine = True 
      .IgnoreCase = True 
      .Pattern = """currentprice""\:""([\d.]+)""" ' capture digits after 'currentprice' in submatch 
      With .Execute(sRespText) 
       If .Count = 0 Then ' no matches, something going wrong 
        aResult(i, 1) = "N/A" 
       Else ' store the price to the array from the submatch 
        aResult(i, 1) = .Item(0).Submatches(0) 
       End If 
      End With 
     End With 
    Next 
    ' output resultion array to column B 
    Output Sheets(1).Range("B1"), aResult 

End Sub 

Function EncodeUriComponent(strText) 
    Static objHtmlfile As Object 
    If objHtmlfile Is Nothing Then 
     Set objHtmlfile = CreateObject("htmlfile") 
     objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript" 
    End If 
    EncodeUriComponent = objHtmlfile.parentWindow.encode(strText) 
End Function 

Sub Output(oDstRng As Range, aCells As Variant) 
    With oDstRng 
     .Parent.Select 
     With .Resize(_ 
      UBound(aCells, 1) - LBound(aCells, 1) + 1, _ 
      UBound(aCells, 2) - LBound(aCells, 2) + 1 _ 
     ) 
      .NumberFormat = "@" 
      .Value = aCells 
      .Columns.AutoFit 
     End With 
    End With 
End Sub 

• Заполненный лист с некоторыми названиями продуктов:

• Запущенный к югу и получил результат:

Это просто пример, как получить данные с веб-сайта с помощью XHR и разобрать ответ с RegExp, я надеюсь, что это поможет.