根据单元格中找到的值向表格添加标题

Question

我得到了创建表格的代码，但我手动输入了标题名称。

标题名称如何引用单元格值？

由于不同的报告，表格会有所不同，因此我需要表格与报告标题相匹配。
报告标题位于“基础数据”工作表上的单元格 D2:AS2 中。新表中有 42 列（从 D 到 AS）。

此外，我希望表格的底行是“总计行”。
例如，A 列的底行将包含 A 列中的值的总和。

Const COL_CNT = 4 ' cols count of the table (ListObject)
Const COL_KEY = "O" ' used to determine the last row
Const FIRST_ROW = 5
Dim i As Variant
i = InputBox("How many DFSP's in this Supply Chain?", "Enter Quantity")
If Not IsNumeric(i) Then
    MsgBox "Please input a number.", vbCritical
    Exit Sub
End If
If i < 1 Then Exit Sub
Dim sht As Worksheet
Dim LastRow As Long
Set sht = Worksheets("Instructions")
LastRow = sht.Cells(sht.Rows.Count, COL_KEY).End(xlUp).Row
With sht.Cells(LastRow, COL_KEY)
    If Len(.Value) > 0 Or (Not .ListObject Is Nothing) Then
        LastRow = LastRow + 1
    End If
    If LastRow < FIRST_ROW Then LastRow = 5
End With
Dim tabRng As Range
Set tabRng = sht.Cells(LastRow, COL_KEY).Resize(i + 1, COL_CNT)
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, tabRng, , xlYes)
objTable.HeaderRowRange.Value = Array("Numeric", "Name", "Alpha", "Location")

Answer 1

• 标题从

  HEADER_RNG

  复制到

  BASE_SHT

  （根据需要修改）
• 新表上的列数由

  HEADER_RNG

  决定。

Sub Demo()
    Const COL_KEY = "O" ' used to determine the last row
    Const FIRST_ROW = 5
    Const HEADER_RNG = "D2:AS2" ' source of header
    Const BASE_SHT = "Base Data"
    Dim i As Variant
    i = InputBox("How many DFSP's in this Supply Chain?", "Enter Quantity")
    If Not IsNumeric(i) Then
        MsgBox "Please input a number.", vbCritical
        Exit Sub
    End If
    If i < 1 Then Exit Sub
    Dim oSht As Worksheet, LastRow As Long
    Set oSht = Worksheets("Instructions")
    LastRow = oSht.Cells(oSht.Rows.Count, COL_KEY).End(xlUp).Row
    With oSht.Cells(LastRow, COL_KEY)
        If Len(.Value) > 0 Or (Not .ListObject Is Nothing) Then
            LastRow = LastRow + 1
        End If
        If LastRow < FIRST_ROW Then LastRow = FIRST_ROW
    End With
    Dim tabRng As Range, headerRng As Range, objTable As ListObject
    set headerRng = Sheets("BASE_SHT").Range(HEADER_RNG)
    Set tabRng = oSht.Cells(LastRow, COL_KEY).Resize(i + 1, headerRng.Columns.Count)
    Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, tabRng, , xlYes)
    objTable.HeaderRowRange.Value = headerRng.Value
End Sub