在获取 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
我需要处理 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