vba - Excel VBA 进度条显示基于活动工作表的宏进度

Question

我在公司的第三周是一名学徒软件开发人员，他们决定让我开始使用 excel 宏和 VBA。到目前为止，这是一个很好的挑战，我正在学习越来越多的阅读代码。我目前的任务是了解公司用来向客户收费的 Excel 拆分器。我已经设法理解代码，以某种方式操纵它，甚至增加了更多的客户和公司。

他们现在要求我对代码进行一些优化并尝试使其运行得更快。我的想法是关闭屏幕更新和所有这些，并尝试显示宏的进度条。我最初希望根据不同的子/功能运行进度条，但这似乎不太容易。

所以：我希望你们中的一个可以帮助/建议我如何根据活动工作表的数量来运行进度条，因为每次拆分器与客户一起完成时，它都会创建一个新工作表。

这是第一家公司的代码：

'Calling the functions
Private Sub CommandButton1_Click()

    UserForm1.Show

    code

    Dim lastrow As Long

        lastrow = Sheets("Koh").Range("A" & Rows.count).End(xlUp).row

    For i = 2 To lastrow
        Call GenericFindAndSplit(Sheets("Koh").Range("A" & i), Sheets("Koh").Range("B" & i), Sheets("Koh").Range("C" & i))
    Next i

End Sub

Function GenericFindAndSplit(SheetName As String, LowExt As Integer, HighExt As Integer)

    Dim count As Integer
        count = 2

'Add a new sheet to the workbook
'Worksheet name is obtained from the "Koh" tab

    Sheets.Add(After:=Sheets(Sheets.count)).Name = SheetName

'Copy first row of the Data sheet and paste to the newly created sheet
    Sheets("Data-KM").Rows(1).EntireRow.Copy
    Sheets(SheetName).Rows(1).PasteSpecial Paste:=xlPasteFormulas

'Search the Data sheet for the selected extensions and paste them on the newly created sheet
    For r = Sheets("Data-KM").UsedRange.Rows.count To 1 Step -1
        If Sheets("Data-KM").Cells(r, "L") >= LowExt And Sheets("Data-KM").Cells(r, "L") <= HighExt Then
                Sheets("Data-KM").Rows(r).EntireRow.Copy
                Sheets(SheetName).Range("A" & count).PasteSpecial Paste:=xlPasteFormulas
            count = count + 1
        End If
    Next

End Function

Sub ExportSheetsToCSV()

'If Dir("C:\Temp\", vbDirectory) = "" Then

    'Kill ("C:\Temp\") & "*.*"

'End If

Dim xWs As Worksheet
Dim xcsvFile As String

    For Each xWs In Application.ActiveWorkbook.Worksheets
    'Loop for each worksheet on the workbook

        If xWs.Name <> "Sheet1" And xWs.Name <> "Data-KM" And xWs.Name <> "Koh" Then
            xWs.Copy
            'Copy worksheet
            xcsvFile = "GlobalCDR_" & ActiveSheet.Name & ".csv"
            'Copies files into the C Drive under Temp
                Application.ActiveWorkbook.SaveAs Filename:="C:\Temp\" & xcsvFile, FileFormat:=xlCSV
                ThisWorkbook.Saved = True
                Application.DisplayAlerts = False
                Application.ActiveWorkbook.Close
        End If
    Next

'Automatically saves and closes workbook
ThisWorkbook.Saved = False
Application.DisplayAlerts = False
'Application.Quit
End Sub

以下是我尝试根据活动工作表编写进度的尝试

Sub code()

Dim i As Integer, j As Integer, pctCompl As Single

For i = 1 To 100
    For ActiveWorkbook = 1 To 7
        ActiveWorkbook.Value = j
    Next j
    pctCompl = i
    progress pctCompl
Next i

End Sub

Sub progress(pctCompl As Single)

UserForm1.Text.Caption = pctCompl & "% Completed"
UserForm1.Bar.Width = pctCompl * 2

DoEvents

End Sub

最后这是我创建的用户窗体的代码：

Private Sub UserForm_Activate()
code
End Sub

非常感谢您提供的任何建议，在此先感谢您，也感谢您之前的贡献，在这三周的时间里，它们对我来说非常宝贵:)

标签： vbaexcelprogress-bar