Question

VB加进度条问题

Private Sub Command1_Click()
Dim oxl As Object
Dim owb1 As Object, owb2 As Object, owb3 As Object
Dim ost1 As Object, ost2 As Object, ost3 As Object
Dim i As Long, j As Long, k As Long, x As Long, y As Long, z As Long, l As Long
Set oxl = CreateObject("Excel.Application")
Set owb1 = oxl.Workbooks.Open(App.Path & "\1.xls")
Set ost1 = owb1.sheets("Sheet1")
Set owb2 = oxl.Workbooks.Open(App.Path & "\2.xls")
Set ost2 = owb2.sheets("Sheet1")
Set owb3 = oxl.Workbooks.Add
Set ost3 = owb3.sheets("Sheet1")
k = 1
x = Val(Text1.Text)
y = Val(Text2.Text)
z = Val(Text3.Text)
l = Val(Text4.Text)
For i = 1 To ost1.UsedRange.Rows.Count
For j = 1 To ost2.UsedRange.Rows.Count
DoEvents
If ost1.cells(i, x) = ost2.cells(j, y) Then
ost3.cells(k, 1) = ost1.cells(i, 1)
ost3.cells(k, 2) = ost1.cells(i, 2)
ost3.cells(k, 3) = ost1.cells(i, 3)
ost3.cells(k, 4) = ost1.cells(i, 4)
ost3.cells(k, z) = ost2.cells(j, l)
'ost3.cells(k, (y + 1)) = ost2.cells(j, (y + 1))
k = k + 1
Exit For
End If
Next
Next
owb3.saveas App.Path & "\3.xls"
owb3.Close
owb2.Close
owb1.Close
oxl.quit
MsgBox "OK"
这个用起来要好久,请问如何加个进度条来查看进度

Answer 1

使用菜单，[工程]--[部件]，勾选 Microsoft Windows Common Controls 6.0 (SP6)，[确定]。
将进度条，添加到窗体。
在你的语句中合适位置增加4行代码，看看效果。

ProgressBar1.Min = 1 '增加的代码
ProgressBar1.Max = ost1.UsedRange.Rows.Count '增加的代码
ProgressBar1.Value = 0 '增加的代码

For i = 1 To ost1.UsedRange.Rows.Count
For j = 1 To ost2.UsedRange.Rows.Count
DoEvents
If ost1.cells(i, x) = ost2.cells(j, y) Then
ost3.cells(k, 1) = ost1.cells(i, 1)
ost3.cells(k, 2) = ost1.cells(i, 2)
ost3.cells(k, 3) = ost1.cells(i, 3)
ost3.cells(k, 4) = ost1.cells(i, 4)
ost3.cells(k, z) = ost2.cells(j, l)
'ost3.cells(k, (y + 1)) = ost2.cells(j, (y + 1))
k = k + 1
Exit For
End If
Next
ProgressBar1.Value = ProgressBar1.Value + 1 '增加的代码
Next

追问

大师出错了，不过我想要在后面加上百分之多少怎么加呢？

Answer 2

一般的健脑的保健品没有明显的副作用,可以适当的用一些.但也不要指望着通过它们来提高记忆力,或者提高智力.它们的作用没有那么强.