Web サイトからすべての HTML テーブルをダウンロードし、ワークシートに解析する VBA アプリケーションがあります。次に、列 A の各テーブルのヘッダーで文字列を検索し、そのセルをアクティブ化し、現在の領域の範囲を識別し、リスト オブジェクト名をワークシート名マネージャーに追加するコードを作成しました。私が抱えている問題は、メッセージボックスにテーブルの行数が表示されるコード行 260 にあります。テーブルの行数が異なる場合でも、数は常に同じです。問題はコード行 210 から 250 にあると思います。スタック オーバーフローを含む Web 全体を検索しましたが、解決策が見つかりません。
メッセージ ボックスに表示された数値がテーブルの行数を反映していない理由が分かる人はいますか?
'---------------------------------------------------------------------------------------
' 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