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

将表格转换为 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

            ' Remove the auto filter.
            If ws.AutoFilterMode Then ws.AutoFilterMode = False
            
            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

Answer 2

试试下面的代码。它将替换工作表名称中的空格。此外，它不使用

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

请注意，您应该 always 使用

Option Explicit

并声明所有变量，并且您应该 never 使用

On Error Resume Next

除了您知道它们可能会失败的单个语句（并且您想自己进行错误处理） .