Question

VBA根据网址下载数据遇到问题求帮助

下面的网址在用浏览器打开是全部有数据的
http://pub.icaile.com/hb11x5kjjg.php?day_id=zt
通过下面代码下载却在第2列得到的全是星号。
Sub 宏1()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://pub.icaile.com/hb11x5kjjg.php?day_id=zt", Destination:=Range( _
"$A$1"))
.Name = "hb11x5kjjg.php?day_id=zt"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
初步原因是第2列数据在浏览器中加载与网页其他部分有个延迟，感官上是第2列随网页整体加载是星号，然后再将数据替换第2列的星号。但是可以肯定，出现星号的时候，网页加载完成的标志（Until .ReadyState = 4）并未出现，这一点我是测试过了的。
请问上面代码怎样根据我的述说更改，才能不至于第2列全是星号。

Answer 1

出现这个问题倒是没想到！

但是PHP生成的静态HTML页面中，这些号码就是星号：

<td class='im' id='w0'>*,*,*,*,*</td>
<td style='display:none;' class="c" n='w0'>QMTEsMDcsMDUsMDgsMDQ=M</td>
<td>2014-03-31 22:00:00</td>
</tr>

你可以打开加载完成后的网页源代码查看。

研究了一下，其实第三列的那串字符其实就是开奖号码，需要转换一下，对照规则如下：

 MDE = 01    

 MDI = 02    

 MDM = 03    

 MDQ = 04    

 MDU = 05    

 MDY = 06    

 MDc = 07    

 MDg = 08    

 MDk = 09    

 MTA = 10    

 MTE = 11    

所以，有了以下代码：

Sub 宏1()
Dim rng As Range, i, d As New Dictionary

    If ActiveSheet.QueryTables.Count > 0 Then '若已有数据连接，则直接刷新
        ActiveSheet.QueryTables(1).Refresh BackgroundQuery:=False
    Else '否则建立数据连接
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://pub.icaile.com/hb11x5kjjg.php?day_id=zt", Destination:=Range( _
            "$A$1"))
            .Name = "hb11x5kjjg.php?day_id=zt"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .WebSelectionType = xlAllTables
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    End If
    
    '建立对照字典
    d.Add "MDE", "01"
    d.Add "MDI", "02"
    d.Add "MDM", "03"
    d.Add "MDQ", "04"
    d.Add "MDU", "05"
    d.Add "MDY", "06"
    d.Add "MDc", "07"
    d.Add "MDg", "08"
    d.Add "MDk", "09"
    d.Add "MTA", "10"
    d.Add "MTE", "11"
    
    For Each rng In Range(Range("B3"), Range("B2").End(xlDown))
        n = ""
        For i = 1 To 5 '将C列字符逐一反编译
            n = n & d.Item(Mid(rng.Offset(0, 1), i * 4 - 2, 3)) & ","
        Next i
        rng.Select
        rng = Left(n, Len(n) - 1) '写入B列
    Next rng
End Sub

以上代码需要引用 Microsoft Scripting Runtime

追问

内容完全正确，我希望这些内容进入变量或数组或剪贴板都行而不进入单元格可以吗？当然指的是不通过单元格辅助赋值。我最终要到数组继续处理，数组最好，我会变量转数组，变量次之，也会剪贴板操作，但能不通过剪贴板最好。

追答

那么就加个数组 arr，其中第1列存储期数，第2至第6列分别存储5个号码（以文本形式，如果需要转换为数字形式，请修改字典数据为数字即可）：

Sub 宏1()
Dim rng As Range, i, d As New Dictionary
Dim arr()
 
    If ActiveSheet.QueryTables.Count > 0 Then
        ActiveSheet.QueryTables(1).Refresh BackgroundQuery:=False
    Else
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://pub.icaile.com/hb11x5kjjg.php?day_id=zt", Destination:=Range( _
            "$A$1"))
            .Name = "hb11x5kjjg.php?day_id=zt"
            '数字超了，这中间的参数就省略了，无关紧要。
            .Refresh BackgroundQuery:=False
        End With
    End If
     
    '数字超了，这段构建字典的代码请自行加上，^_^
         
    ReDim arr(Range("B2").End(xlDown).Row - 2, 6)
    For Each rng In Range(Range("B3"), Range("B2").End(xlDown))
        n = ""
        arr(rng.Row - 2, 1) = rng.Offset(0, -1)
        For i = 1 To 5
            arr(rng.Row - 2, i + 1) = d.Item(Mid(rng.Offset(0, 1), i * 4 - 2, 3))
            n = n & arr(rng.Row - 2, i + 1) & ","
        Next i
        rng = Left(n, Len(n) - 1)
    Next rng
End Sub