[已解决]请高手帮我把这个进度条实例应用到我的代码运行中

jessylake

实例是往一万个单元格里填写数据，那我的代码中怎么计算进度百分比比较准确呢？
进度条实例：
Private Sub CommandButton1_Click()
Dim i As Integer
UserForm2.Show 0 '使用Show方法显示进度条控件所在的窗体，并且设置为无模式显示。
With UserForm2.ProgressBar1
     .Min = 1              '设置进度条控件的最小值和最大值，应与下面for语句循环计数器的start参数和End参数相一致。
     .Max = 10000
     .Scrolling = 0        '设置进度条控件显示为有间隔的。如果将Scrolling属性设置为1则显示为无间隔的。
     For i = 1 To 10000
         Cells(i, 1) = i   '在单元格中进行无意义的填充数据以演示进度条。在实际应用中可以将进度条嵌入到程序的循环中。
         .Value = i
         UserForm2.Caption = "正在运行,已完成" & i / 100 & "%,请稍候!"  '在窗体的标题栏中显示已完成的百分比。
     Next
End With
Unload UserForm2
Columns(1).ClearContents '清空A列填充的数据
End Sub

我的代码：

Sub 新建单词库()
    Dim cFile$, Fso As Object, Fl As Object, i%, j%, k%, n%, m%, cPath$, s&, cFs() As Boolean
    Dim Arr(), Brr(1 To 60000, 1 To 3), wb As Workbook
    Dim d As Object, lab As Boolean
    Dim ExApp As Excel.Application
    Set d = CreateObject("Scripting.Dictionary") '创建字典
    cPath = ThisWorkbook.Path & "\英语单词表\"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    n = Fso.getfolder(cPath).Files.Count
    ReDim cFs(1 To n)
    Application.ScreenUpdating = False
    For Each Fl In Fso.getfolder(cPath).Files
    Debug.Print Fl.Name
        If Not Fl.Name Like "*" & ThisWorkbook.Name & "*" Then
            m = Val(Mid(Fl.Name, 6))
            If m > n Then
                n = m
                ReDim Preserve cFs(1 To m + 10) '重定义数组
            End If
            If m > 0 Then cFs(m) = True
        End If
    Next
    For i = 1 To n
        If cFs(i) Then
            Set ExApp = CreateObject("Excel.application")
            ExApp.Visible = False '新excel程序不可视
            ExApp.AutomationSecurity = 3    '禁用该Excel程序的宏，
            Set wb = ExApp.Workbooks.Open(cPath & "英语单词表" & i & ".xls")   '打开文件
            'Set wb = GetObject(cPath & "英语单词表" & i & ".xls")
            With wb
                Arr = .Sheets(1).UsedRange.Value
               
                For j = 2 To UBound(Arr) Step 2
                    For k = 1 To UBound(Arr, 2)
                        If Arr(j, k) <> "" And Not d.exists(Arr(j, k)) Then
                            d(Arr(j, k)) = Arr(j + 1, k): s = s + 1: Brr(s, 1) = Arr(j, k): Brr(s, 2) = Arr(j + 1, k)
                            If lab = False Then
                               Brr(s, 3) = Arr(1, 1)
                               lab = True
                            End If
                        End If
                        'If j = 2 And k = 1 Then Brr(s, 3) = Arr(1, 1)
                    Next
                Next
                .Close 0
                lab = False
            End With
        End If
    Next
    If s > 0 Then
        Sheets(1).Range("a:c").ClearContents
        Sheets(1).Range("a1:c" & s).Value = Brr
        Application.ScreenUpdating = True
        MsgBox "新建词库完毕。      ", 64, "提示"
    End If
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2014-9-9 08:06

Sub 新建单词库()
    '...............
    UserForm2.Show 0
    With UserForm2.ProgressBar1
        .Min = 1
        .Max = n
        .Scrolling = 0
     End With
    For i = 1 To n
       If cFs(i) Then
          Set ExApp = CreateObject("Excel.application")
          '..................
       End If
       UserForm2.ProgressBar1.Value = i
       UserForm2.Caption = "正在运行,已完成" & Round(i / n )*100 & "%,请稍候!"
      VBA.DoEvents         
    Next
    Unload UserForm2   
    If s > 0 Then
       '.............
End Sub

跳转到最佳答案楼层

zjdh

Sub 新建单词库()
    '...............
    UserForm2.Show 0
    With UserForm2.ProgressBar1
        .Min = 1
        .Max = n
        .Scrolling = 0
     End With
    For i = 1 To n
       If cFs(i) Then
          Set ExApp = CreateObject("Excel.application")
          '..................
       End If
       UserForm2.ProgressBar1.Value = i
       UserForm2.Caption = "正在运行,已完成" & Round(i / n )*100 & "%,请稍候!"
      VBA.DoEvents         
    Next
    Unload UserForm2   
    If s > 0 Then
       '.............
End Sub

jessylake

zjdh 发表于 2014-9-9 08:06
Sub 新建单词库()
    '...............
    UserForm2.Show 0

谢谢老师，百分数计算是不是应该：Round((i / n) * 100, 0)

jessylake

zjdh 发表于 2014-9-9 08:06
Sub 新建单词库()
    '...............
    UserForm2.Show 0

有人说要加个 doevents 这个应该加在哪里？ 起什么作用？

zjdh

jessylake 发表于 2014-9-9 09:04
谢谢老师，百分数计算是不是应该：Round((i / n) * 100, 0)

对！我忽视了。

zjdh

jessylake 发表于 2014-9-9 09:07
有人说要加个 doevents 这个应该加在哪里？ 起什么作用？

这样加
UserForm2.Caption = "正在运行,已完成" & i / n & "%,请稍候!"
VBA.DoEvents