尝试将多个网页中的数据获取到excel中

我试图从以下网页中提取特定的文本字符串：

1504代表年-月，我想将这个数字减少到0504（2005年4月：）

我想知道如何将这个字符串输入到VBA中，并让代码为我完成这项工作，而不是将这个字符串复制/粘贴120次

如果您访问1504和0504之间的任何链接，我要查找的字符串紧跟在第一个“$”之后，直到$结束（9个字符）

提前谢谢你

以下是我通过一些研究发现的代码：

Sub Macro5()
'
' Macro5 Macro
'

'
Dim Erw, firstRow, lastRow
firstRow = 1
Last Row = Range("B" & Rows.Count).End(xlUp).Row
For Erw = firstRow To lastRow
    Dim newRow
    newRow = firstRow + 4
    Range("B" & newRow).Select
    ActiveCell.FormulaR1C1 = Range("B" & newRow)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;ActiveCell.FormulaR1C1", _
        Destination:=Range("$D$5"))
        .Name = "collections1504_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    nextRow = nextRow + 1
    Next Erw
    Range("D3").Select
    Selection.Copy
    Range("C5").Select
    Range("D3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D5:P143").Select
    Application.CutCopyMode = False
    Selection.QueryTable.Delete
    Selection.ClearContents
End Sub

---

我不喜欢查询表，它们对我来说从来没有那么好用过

下面的代码使用实例

InternetExplorer

导航到页面并提取字符串。它需要两个额外的引用才能工作，或者需要修改才能使用CreateObject

添加引用会将对象添加到IntelliType，以便更容易编辑代码

您可以在工作表中使用此函数，多次调用可能会使工作表冻结一段时间，但我想查询表也会发生这种情况

' This function requires references "Microsoft Internet Controls" and "Microsoft HTML Object Library"
Public Function getTax(ByVal DateCode As String) As String
Dim Browser As InternetExplorer
Dim Document As HTMLDocument
Dim Element As IHTMLElement
Dim Content As String
Dim Response As String
Dim Address As String
Dim Count As Integer: Count = 0

Address = "http://comptroller.texas.gov/taxinfo/salestax/collections" & DateCode & ".html"

Set Browser = New InternetExplorer
Browser.Navigate Address

Do While Browser.Busy And Not Browser.ReadyState = READYSTATE_COMPLETE
    DoEvents
Loop

Set Document = Browser.Document

Do
    Set Element = Document.getElementById("fullPage")

    If Not Element Is Nothing Then
        Exit Do
    Else
        If Count > 5 Then
            Debug.Print "Error: getTax failed to find element."
            Exit Do
        Else
            ' Document might not be ready, give it a second. and try again
            Count = Count + 1
            Application.Wait (Now + #12:00:01 AM#)
        End If
    End If        
Loop

If Element Is Nothing Then
    Response = "[ERROR]"
Else
    Content = Element.innerText
    Response = Mid(Content, InStr(1, Content, "$") + 1, 7)
End If

Set Document = Nothing
Set Element = Nothing
Set Browser = Nothing

getTax = Response

End Function

---

我也宁愿直接扫描网页内容。我的方法将所有结果以图表形式放在电子表格上。这里有另一种方法来实现您的目标：

选项显式
子GetSalesTaxData（）
Dim ie作为InternetExplorer
以月份为日期
将url设置为字符串
作为字符串的引线
作为字符串的Dim前缀
作为整数的Dim pos1
作为整数的Dim pos2
Dim-taxStr作为字符串
变暗目的地范围
将行偏移量设置为整数
taxMonth=日期价值（“4/1/2015”）
URLEADER=”http://comptroller.texas.gov/taxinfo/salestax/collections"
前缀=“存入政府一般收入总额”
设置目的地=范围（“A1”）
rowOffset=0
Set ie=新的InternetExplorer
可见=假
Do While taxMonth>DateValue（“3/1/2005”）
url=URLEADER&Right（年份（纳税月份），2）和格式（Int（月份（纳税月份）），“00”）和“.html”
浏览网址
在ie.ReadyState ReadyState\u完成时执行此操作
多芬特
环
pos1=InStr（1，即.Document.body.innerhtml，前缀，vbTextCompare）+Len（前缀）+1
pos2=InStr（pos1，即.Document.body.innerhtml，“百万”，vbTextCompare）
taxStr=Mid（即，Document.body.innerhtml，pos1，（pos2-pos1-1））
'---基本字符串清理：去掉前导“$”和逗号
taxStr=Replace（taxStr，“$”，“，”，vbTextCompare）
taxStr=Replace（taxStr，，，，，，，，vbTextCompare）
'在其中一个答案上有一个尾随'。'出于某种原因
如果正确（taxStr，1）=“”，则
taxStr=Left（taxStr，Len（taxStr）-1）
如果结束
“---将其存储在工作表中
目标单元格（1+行偏移量，1）。值=taxMonth
目标单元格（1+行偏移，2）。值=CDbl（taxStr）
rowOffset=rowOffset+1
“将日期减少一个月
taxMonth=DateAdd（“m”，-1，taxMonth）
环
设置ie=无
端接头

Excel是从哪里来的？我在上面添加了代码@邦德，我正试图将这些数据导入excel，然后对其进行进一步分析。所以。。。数据可以去任何地方或。。。？第一个美元是“4月份22.977亿美元……”。9个字符为“2297.7米”。这就是你想要的？我想要右边下一列中的数据。我想如果您要排除$符号，它将是7。我还将代码编辑为当前的状态。我尝试运行您的代码，但由于“用户定义类型未定义”而无法编译。抱歉，您必须向Microsoft internet库添加库引用。那会解决的。