[已解决]怎样添加进度条

9910343

怎样添加进度条 Book1.rar (12.24 KB, 下载次数: 16)

2012-11-22 20:29 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

爱疯

2012-11-22 21:04

楼主只想知道怎么加进度条吗？这样够慢了，好看变化。

1、没改成数组
2、约9000多行数据

示例4.rar (79.15 KB, 下载次数: 44)

2012-11-22 21:04 上传

点击文件名下载附件

1. 
   
2. 
   
3. Sub test()
   
4.     Dim d As Object, i, j
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Sheets("消费")
   
7.         r = .Range("a1").CurrentRegion.Rows.Count
   
8.         For i = 2 To r
   
9.             d(.Cells(i, 1).Value) = .Cells(i, 3)
   
10.         Next
    
11.     End With
    
12. 
    
13.     UserForm1.Show 0
    
14.     With Sheets("资料")
    
15.         r = .Range("a1").CurrentRegion.Rows.Count
    
16.         For i = 2 To r
    
17.             '调整宽度，显示百分比
    
18.             UserForm1.Label1.Width = i / r * UserForm1.Width
    
19.             UserForm1.Caption = Format(i / r, "0%")
    
20.             '重复动作
    
21.             If d.exists(.Cells(i, 1).Value) Then
    
22.                 .Cells(i, 3) = d(.Cells(i, 1).Value)
    
23.             End If
    
24.             
    
25.             DoEvents
    
26.         Next i
    
27.     End With
    
28.     Unload UserForm1
    
29. End Sub
    
30. 
    

复制代码

跳转到最佳答案楼层

爱疯

楼主只想知道怎么加进度条吗？这样够慢了，好看变化。

1、没改成数组
2、约9000多行数据

示例4.rar (79.15 KB, 下载次数: 44)

2012-11-22 21:04 上传

点击文件名下载附件

1. 
   
2. 
   
3. Sub test()
   
4.     Dim d As Object, i, j
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Sheets("消费")
   
7.         r = .Range("a1").CurrentRegion.Rows.Count
   
8.         For i = 2 To r
   
9.             d(.Cells(i, 1).Value) = .Cells(i, 3)
   
10.         Next
    
11.     End With
    
12. 
    
13.     UserForm1.Show 0
    
14.     With Sheets("资料")
    
15.         r = .Range("a1").CurrentRegion.Rows.Count
    
16.         For i = 2 To r
    
17.             '调整宽度，显示百分比
    
18.             UserForm1.Label1.Width = i / r * UserForm1.Width
    
19.             UserForm1.Caption = Format(i / r, "0%")
    
20.             '重复动作
    
21.             If d.exists(.Cells(i, 1).Value) Then
    
22.                 .Cells(i, 3) = d(.Cells(i, 1).Value)
    
23.             End If
    
24.             
    
25.             DoEvents
    
26.         Next i
    
27.     End With
    
28.     Unload UserForm1
    
29. End Sub
    
30. 
    

复制代码

9910343

爱疯 发表于 2012-11-22 21:04
楼主只想知道怎么加进度条吗？这样够慢了，好看变化。

1、没改成数组

改成数组能不能快些，谢谢

9910343

爱疯 发表于 2012-11-22 21:04
楼主只想知道怎么加进度条吗？这样够慢了，好看变化。

1、没改成数组

• DoEvents
  这是什么意思
  

爱疯

1. 
   
2. Sub a()
   
3.     Dim i
   
4.     For i = 1 To 100 Step 0.05    ' 循环100次
   
5.         Sheet1.Shapes("太阳形 1").Top = i
   
6.         Sheet1.Shapes("太阳形 1").Left = i
   
7.         DoEvents    ' 将执行让给操作系统。
   
8.     Next i    ' 将循环计数器加一。
   
9. End Sub
   

复制代码

ddd.rar (10.04 KB, 下载次数: 23)

2012-11-23 10:00 上传

点击文件名下载附件


第1次，直接运行
第2次，注释或删除掉         DoEvents    ' 将执行让给操作系统。
就看到区别了

爱疯

1. 
   
2. Sub aa()
   
3.     Dim A    '消费数组
   
4.     Dim B    '资料数组
   
5.     Dim d As Object, i As Integer
   
6. 
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     B = Sheets("资料").Range("a1").CurrentRegion
   
9.     '建立
   
10.     For i = 2 To UBound(B)
    
11.         d(B(i, 1)) = B(i, 3)
    
12.     Next
    
13.     With Sheets("消费")
    
14.         '查询
    
15.         A = .Range("a1").CurrentRegion
    
16.         For i = 2 To UBound(A)
    
17.             If d.exists(A(i, 1)) Then A(i, 3) = d(A(i, 1))
    
18.         Next
    
19.         '输出
    
20.         .Range("c2:c65536").ClearContents
    
21.         .Range("a1").Resize(UBound(A), UBound(A, 2)) = A
    
22.     End With
    
23. End Sub
    

复制代码

Book1b.rar (13.35 KB, 下载次数: 18)

2012-11-23 10:16 上传

点击文件名下载附件

根据工作表的名称、记录数看，1楼把建立和查询的数据源搞反了。
如果要拿着用，还是用这种

9910343

爱疯 发表于 2012-11-23 10:20
根据工作表的名称、记录数看，1楼把建立和查询的数据源搞反了。
如果要拿着用，还是用这种

还有一个问题是，如果资料表里单元格有公式，更新后单元格里的公式怎么都消除了；