最後の行と列のリストテーブル名とセル

Question

シートのすべてのテーブル名と、最後の行と列のテーブルの対応するセルを一覧表示します。以下のコードは、シート "A1.6Laster"（テーブル "Lastkategori"を除く）のテーブル名を見つけて、シート "A1.6.5Lastkombinationer"にリストします。

テーブル「A1.6Laster」を追加/削除できるので、リストは最初に削除/消去されます。

つまり、下のコードはテーブルの名前を細かく表示しますが、名前リストの隣の列には、最後の行と列の各テーブルの対応するセルもリストされます。 For Eachループにコードを追加する必要がありますか？

すべての入力は歓迎です。詳細情報が必要な場合はお問い合わせください。

Sub Laster() 
Dim tbl As ListObject 
Dim wsSummary As Worksheet 
Dim ws As Worksheet 
Dim lRow As Long 
Dim SearchText As String 
Dim GCell As Range 

SearchText = "Laster" 
Set GCell = Worksheets("A1.6.5Lastkombinationer").Cells.Find(SearchText).Offset(0) 
Set wsSummary = Worksheets("A1.6.5Lastkombinationer") 
Set ws = Worksheets("A1.6Laster") 

With Worksheets("A1.6.5Lastkombinationer").ListObjects("Laster").DataBodyRange 
If .Rows.Count > 1 Then 
    .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete 
End If 
End With 
Worksheets("A1.6.5Lastkombinationer").ListObjects("Laster").DataBodyRange.Rows(1).ClearContents 

lRow = GCell.Row 
    For Each tbl In Worksheets("A1.6Laster").ListObjects 
     If tbl.Name <> "Lastkategori" Then 
     lRow = lRow + 1 
     With wsSummary 
      .Cells(lRow, "A") = tbl.Name 
     End With 
     End If 
    Next tbl 

ws.ListObjects("Lastkategori").ListColumns(1).DataBodyRange.Copy 
wsSummary.ListObjects("Laster").DataBodyRange(1, 1).End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues 
Application.CutCopyMode = False 

End Subの

Answer 1

あなたが最後の行と列は各テーブルの右下隅のセルを意味し、言うとき、私は想定しています。

With wsWsummary ... End Withで次のスニペットを追加します。それは、各テーブルのデータ範囲のセルの範囲をとり、最後の行の最後の列を取得し、そのセルのデータをテーブルの名前の隣の列に吐き出すことです。

 Dim r As Range 
     Dim last As Range 

     Set r = tbl.DataBodyRange 
     Set last = r.Cells(r.Rows.Count, r.Columns.Count) 
     ws.Cells(lRow, "B").Value = last