VBA 创建和重命名表

Question

我希望在不选择第一行并创建表格的情况下创建表格。然后根据工作表名称命名表格。

Sub ConvertDataToTables()
 
'  For i = 3 To 5
'    Sheets(i).Activate
'    Rows(1).EntireRow.Delete
'  Next i
  
  For i = 3 To 5
    On Error Resume Next
    Sheets(i).Select
    ActiveSheet.ShowAllData
    Cells.AutoFilter
    Range("A2").CurrentRegion.Select
    If ActiveSheet.ListObjects.Count < 1 Then
        ActiveSheet.ListObjects.Add.Name = ActiveSheet.Name
    End If
  Next i

表名由带空格的下划线组成，我不希望这样。所以 Sum Day = Sum_Day 来自我的代码。我还想让选择不选择顶行，而是选择下面的所有内容。

Answer 1

试试下面的代码。它将替换工作表名称中的空格。此外，它不使用 Select 来依赖 ActiveSheet - 如需进一步阅读，请参阅 How to avoid using Select in Excel VBA

该代码使用中间范围变量来定义表的范围。它从单元格 A2 (startCell) 开始，并将 CurrentRegion 的最后一个单元格用作 endCell。

Dim sheetIndex As Long
For sheetIndex = 3 To ThisWorkbook.Worksheets.Count
    With ThisWorkbook.Worksheets(sheetIndex)
        If .ListObjects.Count = 0 Then
            Dim startcell As Range, endCell As Range, tableRange As Range
            Set startcell = .Cells(2, 1)
            Set endCell = startcell.CurrentRegion.Cells(startcell.CurrentRegion.Cells.Count)
            Set tableRange = .Range(startcell, endCell)
            Debug.Print tableRange.Address
            .ListObjects.Add(xlSrcRange, tableRange).Name = Replace(.Name, " ", "")
        End If
    End With
Next sheetIndex

请注意，您应该总是使用Option Explicit 并声明所有变量，你应该绝不使用 On Error Resume Next 除了您知道它们可能会失败的单个语句（并且您想自己进行错误处理）。

Answer 2

将表格转换为 Excel 表格 (ListObject)

Option Explicit

Sub ConvertDataToTables()
 
    Const FIRST_CELL As String = "A2"
    Const FIRST_INDEX As Long = 3
    Const LAST_INDEX As Long = 5
     
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet, rg As Range, fCell As Range, lo As ListObject
    Dim i As Long, NewName As String
    
    For i = FIRST_INDEX To LAST_INDEX
        
        Set ws = wb.Worksheets(i)
        
        If ws.ListObjects.Count = 0 Then
            
            If ws.FilterMode Then ws.ShowAllData
            
            NewName = Replace(Application.Proper(ws.Name), " ", "")
            ws.Name = NewName
            
            Set fCell = ws.Range(FIRST_CELL)
            With fCell.CurrentRegion
                Set rg = fCell.Resize(.Row + .Rows.Count - fCell.Row, _
                    .Column + .Columns.Count - fCell.Column)
            End With
            
            Set lo = ws.ListObjects.Add(xlSrcRange, rg, , xlYes)
            lo.Name = NewName
            
        End If
        
    Next i
    
End Sub