Excel数据导入特定单元格

我想列出设备，并把他们的价格放在旁边。

我的目标是每周检查不同的网站并注意趋势。

这是一个爱好项目，我知道有网站已经这样做。

例如：

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 

手工，这是很多工作（每周检查），所以我认为Excel中的macros将有所帮助。 问题是，我想把数据放在一个单元格中，而excel只能识别表格。 解决scheme：查看源代码，读取价格，导出价格到特定单元格。

我认为这在Excel中是完全可能的，但是我不能清楚地知道如何读取价格或其他给定的数据以及如何将其放入一个特定的单元格中。 我可以在源代码中指定坐标，还是有更有效的思维方式？

在此先感谢，所有的提示和解决scheme，欢迎！

Answer 1

首先，你必须找出网站是如何工作的。 对于你问的页面 ，我做了以下工作：

• 在Chrome中打开http://www.mediamarkt.de页面。
• 在search框中键入BOSCH WTW 85230，出现了build议列表。
• 按F12打开开发人员工具，然后单击“networking”选项卡。
• 每次我打字时，都会出现新的要求（见黄色部分）：

• 点击请求检查一般信息：

您可以看到它使用GET方法和一些参数，包括url编码的产品名称。

• 单击“响应”选项卡检查从服务器返回的数据：

你可以看到它是一个普通的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"}]} 

在这里你可以find"currentprice":"444.00"属性与价格。

• 通过抛出一些可选参数来简化请求，事实certificate，URL可以接收到相同的JSON响应。http://www.mediamarkt.de/FACT-Finder/Suggest.ff? channel=mmdede&query=BOSCH+WTW+ 85230
• 这些数据足以构build一些代码，假设用于产品的第一列：

 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从网站检索数据并使用RegExpparsing响应，我希望这有助于。