Question

我有一个问题是将整个数组转储到工作表中。 b / c是不是定义为变体？

Sub pix()
    Dim htm As Object
    Dim Tr As Object
    Dim Td As Object
    Dim Tab1 As Object
    Dim tblArr(500) As String
    Dim this$
    Dim counter#

    Web_URL = "pathtosite"
    Set HTML_Content = CreateObject("htmlfile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", Web_URL, False
        .send
        HTML_Content.body.innerHTML = .responseText
    End With
    counter = 0

    For Each Tab1 In HTML_Content.getElementsByTagName("div")
        If Tab1.className = "resizing-cig" Then
            this = Tab1.innerText
            tblArr(counter) = this
        End If
        counter = counter + 1
    Next Tab1

    ThisWorkbook.Sheets("Sheet2").Range("A1:A500").Value2 = tblArr 'This line

End Sub

Answer 1

从评论中收集问题

将2D数组放在工作表上
使用动态数组大小
仅在找到新数据点时递增计数器
可选：清除旧数据
声明所有变量 - 您应该使用Option Explicit
说明没有结果的可能性

Sub pix()
    Dim htm As Object
    Dim Tr As Object
    Dim Td As Object
    Dim Tab1 As Object
    Dim tblArr() As String
    Dim this$
    Dim counter#
    Dim Web_URL$
    Dim HTML_Content As Object

    ' Clear old data
    With ThisWorkbook.Sheets("Sheet2")
        .Range(.Cells(1, 1), Cells(.Rows.Count, 1).End(xlUp)).ClearContents
    End With

    Web_URL = "http://magic.wizards.com/en/articles/archive/card-image-gallery/eternal-masters"
    Set HTML_Content = CreateObject("htmlfile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", Web_URL, False
        .send
        HTML_Content.body.innerHTML = .responseText
    End With

    ReDim tblArr(1 To 500) As String
    counter = 1

    For Each Tab1 In HTML_Content.getElementsByTagName("div")
        If Tab1.className = "resizing-cig" Then
            this = Tab1.innerText
            tblArr(counter) = this
            counter = counter + 1

            ' Increase array size if full
            If counter > UBound(tblArr) Then
                ReDim Preserve tblArr(1 To UBound(tblArr) + 500)
            End If
        End If
    Next Tab1

    ' resize result array to actual results
    If counter > 1 Then
        ReDim Preserve tblArr(1 To counter - 1)
        ' Transpose to 2D array
        ThisWorkbook.Sheets("Sheet2").Range("A1").Resize(UBound(tblArr), 1).Value2 = Application.Transpose(tblArr)
    End If
End Sub

Answer 2

您好最好使用foreach循环转储值

j=0
for each element in tblArr

   if element <> "" then

     ThisWorkbook.Sheets("Sheet2").Range("A1:A500").offset(j,0).Value2 = element 
     j=j+1

   end if
next element

希望这可以帮助你:)。

阵列不会转储到工作表？ VBA

2 个答案: