Range.Areas возвращает неправильное количество строк

Question

У меня есть приложение VBA, которое загружает все HTML-таблицы с веб-сайта и анализирует их на листе. Затем я написал код, который найдет строку в заголовке каждой таблицы в столбце A, активирует эту ячейку, определит диапазон currentregion и добавит имя списка в менеджер имен таблиц. Проблема, с которой я столкнулась, - это строка кода 260, где в окне сообщения отображается количество строк в таблице. Число всегда одно и то же, даже если таблицы имеют различное количество строк. Я считаю, что проблема в кодовых строках с 210 по 250. Я искал по всей сети, включая переполнение стека и не могу найти решение.

Может ли кто-нибудь понять, почему номер, отображаемый в окне сообщения, не отражает количество строк в таблице?

'--------------------------------------------------------------------------------------- 
' Method : test_currentregion_IncludeHeaders 
' Author : Richard 
' Date : 10/4/2016 
' Purpose: Find cell with value and turn into named table with headers 
'--------------------------------------------------------------------------------------- 
Sub test_currentregion_IncludeHeaders() 

10  On Error GoTo test_currentregion_IncludeHeaders_Error 

      'convert all tables (listobjects) to ranges 
      Dim WS As Worksheet, LO As ListObject 
20  For Each WS In Worksheets 
30   For Each LO In WS.ListObjects 
40    LO.Unlist 
50   Next 
60  Next 

      'find currentregions and add table 
      Dim tbl As Object 
      Dim c As Object 
      Dim firstAddress As Variant 
      Dim Hdr As String 
      Dim rngTable As Range 
      Dim rows As Long 
      Dim Line As Variant 
      Dim iCounter As Long 

70  Hdr = "Header" 
80  iCounter = 1 
90  rows = 0 

100  With ThisWorkbook.Worksheets(1).Range("A:A") 
110   Set c = .Find(Hdr, LookIn:=xlValues) 
120   If Not c Is Nothing Then 
130    firstAddress = c.Address 
140    c.Select  'must select object 
150   End If 

160  Do 

170  With ThisWorkbook.Worksheets(1) 
180   Set rngTable = c.CurrentRegion 
190   .ListObjects.Add(SourceType:=xlSrcRange, Source:=rngTable, _ 
       xlListObjectHasHeaders:=xlYes, TableStyleName:="TableStyleMedium1") _ 
       .Name = "List" & iCounter 
200  End With 

210  With ThisWorkbook.Worksheets(1).ListObjects(1) 
220   For Each Line In .Range.SpecialCells(xlCellTypeVisible).Areas 
230    rows = rows + Line.rows.Count 
240   Next 
250  End With 

260  MsgBox "Number of rows displayed = " & rows 

      'reset selected variables 
270   iCounter = iCounter + 1 
280   rows = 0 
290   Set Line = Nothing 

      'find next currentregion 
300   Set c = .FindNext(c) 
310  Loop While Not c Is Nothing And c.Address <> firstAddress 
320 End With 

330  On Error GoTo 0 
340  Exit Sub 

test_currentregion_IncludeHeaders_Error: 

350  MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure_test_currentregion_IncludeHeaders of Sub current_region" 

End Sub 

Answer 1

Проблема, что у Вас есть то, что вы всегда в виду первый ListObject .ListObjects(1).

Вы можете получить доступ к ListObject, что диапазон принадлежит и вернуть подсчитывать ее строки (исключая заголовки), как это:

rows = rngTable.ListObject.DataBodyRange.rows.Count