數組不會轉儲到工作表？ VBA

Question

我有一個問題將整個數組轉儲到工作表中。它沒有被定義爲變體嗎？

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

從註釋收集問題

1. 地方2D陣列上表僅
2. 使用動態陣列大小
3. 遞增計數器當新數據點被發現
4. 可選的：清除舊數據
5. 申報全部變量 - 您應該使用Option Explicit
6. 帳戶沒有結果

---

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 

希望這可以幫助您:)。