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

Question

我需要在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

如果您能提供此代码可能存在的问题，我们将不胜感激。

Answer 1

列出所有工作表名称

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