Arrays 数组不会转储到表中吗？VBA

我在将整个数组转储到工作表中时遇到问题。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

---

Hi转储值最好使用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

j=0
对于tblArr中的每个元素
如果元素“”那么
此工作簿.Sheets（“Sheet2”）.范围（“A1:A500”）.偏移量（j，0）.值2=元素
j=j+1
如果结束
下一个元素

---

希望这对您有所帮助：）。

从评论中收集问题

将二维阵列放置在图纸上

使用动态数组大小

仅当找到新数据点时递增计数器

可选：清除旧数据

声明所有变量-您应该使用

Option Explicit

说明没有结果的可能性

---

---

您需要将其定义为2D数组-

Dim tblArr（1到500，1到1）

并像加载

tblArr（counter，1）=…

一样加载它，然后初始化

counter=1

@chrisneilsen正如我认为忘记WS对象是2D数组是多么愚蠢一样，“不工作”我只是运行了你的代码（用我的mods），它确实在工作表上写了一些东西。因此，一般的方法是有效的，我无法判断它是否正确。可能您需要做的就是将

计数器=计数器+1

移动到

if

块中。此外，你可以使大小动态（你目前假设一个最大500个结果）作为我非常感谢你的输入，这不是一个有效的方法来做到这一点。当我用be 1k+行完成此项目时，多次直接写入工作表是最糟糕的，也是我完成的输出。我上面的方法是有效的，只是我有一些用户错误。我会检查你提议的效率。也许我没有帮你，但至少我学到了一些东西。请记住，如果使用我的方法，则需要根据范围和阵列大小进行调整。如果有差异，输出结果会变得很奇怪（我相信你在处理它时会注意到）

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