在获取 Excel 工作簿中所有工作表名称的列表期间,VBA 代码的执行速度非常慢

Very slow execution of VBA code during getting the list of all worksheet names in an Excel Workbook

我需要处理 Excel 中包含数百个特定工作表的工作簿。我创建了这个简单的代码来获取名为“Spis faktur”的所有这些工作表的名称列表。 代码运行良好,但速度非常慢。似乎它在 0.3 秒内执行了特定工作表的一个名称,因此它需要很长时间才能完成所有工作表名称的执行。

Sub ListSheets() 
Dim sh As Worksheet
Const txt = "Spis faktur"

Set sh = Sheets(txt)
  For i = 1 To Worksheets.Count
      sh.Cells(i + 1, 1) = ThisWorkbook.Sheets(i).Name
  Next i
End Sub

对于这段代码可能有什么问题的任何建议,我们将不胜感激。

列出所有工作表名称

    Option Explicit
    
    Sub ListWorkSheets()
        
        Const dName As String = "Spis faktur"
        Const dfCellAddress As String = "A2"
        
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

        Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
        Dim wsnCount As Long: wsnCount = wb.Worksheets.Count
        
        Dim WorksheetNames() As String: ReDim WorksheetNames(1 To wsnCount, 1 To 1)
        
        Dim sws As Worksheet
        Dim n As Long
        
        ' Write to array.
        For Each sws In wb.Worksheets
            n = n + 1
            WorksheetNames(n, 1) = sws.Name
        Next sws
    
        ' Write to range.
        Dim dfCell As Range: Set dfCell = dws.Range(dfCellAddress)
        Dim drg As Range: Set drg = dfCell.Resize(wsnCount)
        drg.Value = WorksheetNames
    
        ' Clear below.
        Dim dclrrg As Range: Set dclrrg _
            = drg.Resize(dws.Rows.Count - drg.Row - wsnCount + 1).Offset(wsnCount)
        dclrrg.ClearContents ' or dclrrg.Clear
    
    End Sub