Array Wont Dump to Sheet? VBA

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

Сбор вопросов от комментариев

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

Привет сбросить значение от его лучше использовать цикл по каждому элементу

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 

Надеется, что это помогает вам :).