在执行一个耗时比较久的VBA程序时，能不能设置显示出个进度条来？

longkui1990

比如附件所示的xls
我想把除了土黄色之外的其他颜色全部清除掉
VBA跑一下大概要小半分钟
怎么能加个进度显示的东西方便看出来执行到百分之多少的
O(∩_∩)O谢谢




改变单元格背景色.rar (178.66 KB, 下载次数: 12)

2017-4-22 11:25 上传

点击文件名下载附件

liucqa

论坛搜索 进度条，用窗体做的很多

longkui1990

liucqa 发表于 2017-4-20 10:32
论坛搜索 进度条，用窗体做的很多

看了下。感觉都不简单。。

一指禅62

我个人喜欢用  Application.StatusBar  。供参考

1. Sub 显示进度()
   
2.     Dim i&, x&
   
3.     Const m = 100000
   
4.     For i = 1 To m
   
5.         x =int( i / m * 100)
   
6.         If x Mod 5 = 0 Then Application.StatusBar = "程序运行中……    进度 " & x & "%"
   
7.     Next
   
8.     MsgBox "OK!"
   
9.     Application.StatusBar = False
   
10. End Sub

复制代码

一指禅62

Application.StatusBar显示进度.zip (6.27 KB, 下载次数: 254)

2017-4-20 16:54 上传

点击文件名下载附件

longkui1990

一指禅62 发表于 2017-4-20 16:52
我个人喜欢用  Application.StatusBar  。供参考

已经补充了说明和附件
麻烦老兄再抽空帮忙看看
O(∩_∩)O谢谢

一指禅62

longkui1990 发表于 2017-4-22 11:29
已经补充了说明和附件
麻烦老兄再抽空帮忙看看
O(∩_∩)O谢谢

用进度条的代码中必须使用 DoEvents ，这将牺牲计算速度，不太理想——如果观点错误，请指正。

1. Public Sub 改颜色()
   
2.     Dim iColor&, m1&, M&, Rng As Range, myRng As Range
   
3.     iColor = Worksheets("sheet1").Range("a1").Interior.Color
   
4.     Set myRng = Worksheets("sheet1").Range("a2:n43201")
   
5.     'M = WorksheetFunction.CountA(myRng) '这是非空单元格个数，不准确
   
6.     M = 14 * 43200
   
7.     If M = 0 Then Exit Sub
   
8.     For Each Rng In myRng
   
9.         If Rng.Interior.Color <> iColor Then
   
10.             Rng.Interior.Color = 16777215 ' xlNone  不同版本的颜色代码不一样
    
11.         End If
    
12.         m1 = m1 + 1
    
13.         If Int(m1 / M * 100) = m1 / M * 100 Then Application.StatusBar = "正在运行中……  进度 " & Int(m1 / M * 100) & "%"
    
14.     Next
    
15.     Application.StatusBar = False
    
16. End Sub

复制代码

一指禅62

改变单元格背景色.zip (312.14 KB, 下载次数: 409)

2017-4-24 09:15 上传

点击文件名下载附件

longkui1990

一指禅62 发表于 2017-4-24 09:15

太牛了。。
多谢老兄，我琢磨下先