在计算过程中显示进度条 [英] Display a Progress bar during calculation
本文介绍了在计算过程中显示进度条的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
全部晚上
我有一个工作簿，当"更新Pc"时按下Cmd按钮运行相当长的计算，这可能需要30秒才能完成。
I have a workbook which when "Update Pc" Cmd button is pressed run quite a lengthy calculation, which can take up to 30 seconds to complete.
我设法找到了几个显示"计算..."的线程。 "在状态栏或"计算"中在消息框中。我想使用第二个选项进行可能的更改。
I have managed to find a couple of threads which either displays "Calculating..." in the Status bar or "Calculating" in a message box. I would like to use the second option with possible alterations.
我希望在整个计算过程中在屏幕上显示进度条，显示计算完成的实际百分比，或者是否这是不可能的一个动画条，它从Userform
或最好是Msgbox从左到右移动，然后在完成计算宏时消失。
I would ideally like to show a progress bar on screen throughout the calculation process which either shows the actual percentage of calculation complete, or if that is not possible then an animated bar which moves from left to right of either a Userform or preferably a Msgbox which then disappears on completion of the calculation macro.
或
如果第一个选项不可能，则显示"Calculating ....."。在没有按钮的Msgbox或关闭Msgbox的选项中，当计算宏完成时再次消失。
If the first option is not possible display "Calculating....." in a Msgbox without buttons or the option to close the Msgbox, which than again disappears when the calculation macro is complete.
谢谢
Steve
宏代码循环如下
' AssistPC macro
' Keyboard Shortcut: Ctrl+m
' Jan/Feb 2017 for assisting in PC trials
' Aim is to present a data set to assist in guiding an EXTAC876 PC Trial
Option Explicit
Dim runfrom As String
Const MaxDataSets As Integer = 2 ' Now simplified to targets and contacts
Const MaxContacts As Integer = 120
Const MaxLaps As Integer = 10
Const Pi As Single = 3.14159265359
Dim Datasets(MaxDataSets), Laps(MaxLaps) As String
Dim NumberPositions(MaxDataSets), NoDataSets, NoLaps As Integer
Dim LatPosition(MaxContacts, MaxDataSets), LongPosition(MaxContacts, MaxDataSets) As Double
Dim LapPositions(2, 2, MaxLaps) As Double ' Lat and Long from position 1 to 2 for Lap whatever..
Dim Distances(MaxContacts, MaxDataSets, MaxContacts, MaxDataSets) As Single ' Dist(4,3,2,1) is distance between DataSet1 Contact2 to DataSet3 Contact4.
Dim CPA(MaxLaps, MaxContacts) As Single ' CPA between each of the targets and each of the search laps
Dim XStart, XEnd, YStart, YEnd As Single ' X and Y distances between start and end of a lap from a target position
Dim DVal1, DVal2, DVal3 As Double ' DVals used in the distance calculation
Dim MinDist As Single ' Used in nearest neighbour calculation
Dim MinName As String ' Used in nearest neighbour calculation
Dim MaxLat, MinLat, MaxLong, MinLong, MidLat, MidLong As Single ' Start of X/Y calculations for graphic output
Dim XTargContDists(MaxContacts, MaxDataSets), YTargContDists(MaxContacts, MaxDataSets) As Single ' X and Y axis distances for targets and contacts from the Mid Lat/Long position of the entries
Dim XYLapPos(2, 2, MaxLaps) As Single ' X and Y axis distances for Lap start/end from Mid Lat/Long position of the entries
Dim PCHit(MaxContacts) As Integer
Dim PCResult As Single
Dim Counter1, Counter2, Counter3, Counter4, RowCount, ColumnCount As Integer ' Integer counters in arrays or loops
Sub AssistPC()
runfrom = ActiveSheet.Name
' Initialise
NoDataSets = MaxDataSets
NoLaps = MaxLaps
Counter1 = 1
Do While Counter1 <= MaxDataSets
Datasets(Counter1) = ""
NumberPositions(Counter1) = 0
Counter2 = 1
Do While Counter2 <= MaxContacts
LatPosition(Counter2, Counter1) = 0
LongPosition(Counter2, Counter1) = 0
Counter3 = 1
Do While Counter3 <= MaxDataSets
Counter4 = 1
Do While Counter4 <= MaxContacts
Distances(Counter4, Counter3, Counter2, Counter1) = 0
Counter4 = Counter4 + 1
Loop
Counter3 = Counter3 + 1
Loop
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
Counter1 = 1
Do While Counter1 <= MaxLaps
Laps(Counter1) = ""
Counter2 = 1
Do While Counter2 <= 2
Counter3 = 1
Do While Counter3 <= 2
LapPositions(Counter3, Counter2, Counter1) = 0
Counter3 = Counter3 + 1
Loop
Counter2 = Counter2 + 1
Loop
Counter2 = 1
Do While Counter2 <= MaxContacts
CPA(Counter1, Counter2) = 0
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
Counter1 = 1
PCResult = 0
Do While Counter1 <= MaxContacts
PCHit(Counter1) = 0
Counter1 = Counter1 + 1
Loop
Counter1 = 1
Do While Counter1 <= MaxContacts
Worksheets("Targets").Cells(Counter1 + 1, 10) = ""
Worksheets("Targets").Cells(Counter1 + 1, 11) = ""
Worksheets("Contacts").Cells(Counter1 + 1, 10) = ""
Worksheets("Contacts").Cells(Counter1 + 1, 11) = ""
Counter2 = 1
Do While Counter2 <= MaxLaps
Worksheets("Laps").Cells(Counter2 + 2, Counter1 + 15) = ""
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
' Start of input capture
Datasets(1) = "Targets"
Datasets(2) = "Contacts"
Counter1 = 1
Do While Counter1 <= NoDataSets
Counter2 = 1
Do While Counter2 <= MaxContacts
If (Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 2) = "") Then
Counter2 = MaxContacts
Else
NumberPositions(Counter1) = Counter2
LatPosition(Counter2, Counter1) = Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 2) + (Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 3) / 60) + (Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 4) / 3600)
LongPosition(Counter2, Counter1) = Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 5) + (Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 6) / 60) + (Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 7) / 3600)
End If
If (Worksheets(Datasets(Counter1)).Cells(1, 2) = "South") Then LatPosition(Counter2, Counter1) = -LatPosition(Counter2, Counter1)
If (Worksheets(Datasets(Counter1)).Cells(1, 5) = "West") Then LongPosition(Counter2, Counter1) = -LongPosition(Counter2, Counter1)
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
Counter1 = 1
Do While Counter1 <= MaxLaps
If (Worksheets("Laps").Cells(Counter1 + 2, 1) = "") Then
Counter1 = MaxLaps
Else
NoLaps = Counter1
LapPositions(1, 1, Counter1) = Worksheets("Laps").Cells(Counter1 + 2, 2) + (Worksheets("Laps").Cells(Counter1 + 2, 3) / 60) + (Worksheets("Laps").Cells(Counter1 + 2, 4) / 3600)
LapPositions(1, 2, Counter1) = Worksheets("Laps").Cells(Counter1 + 2, 5) + (Worksheets("Laps").Cells(Counter1 + 2, 6) / 60) + (Worksheets("Laps").Cells(Counter1 + 2, 7) / 3600)
LapPositions(2, 1, Counter1) = Worksheets("Laps").Cells(Counter1 + 2, 9) + (Worksheets("Laps").Cells(Counter1 + 2, 10) / 60) + (Worksheets("Laps").Cells(Counter1 + 2, 11) / 3600)
LapPositions(2, 2, Counter1) = Worksheets("Laps").Cells(Counter1 + 2, 12) + (Worksheets("Laps").Cells(Counter1 + 2, 13) / 60) + (Worksheets("Laps").Cells(Counter1 + 2, 14) / 3600)
If (Worksheets("Laps").Cells(2, 2) = "South") Then
LapPositions(1, 1, Counter1) = -LapPositions(1, 1, Counter1)
LapPositions(2, 1, Counter1) = -LapPositions(2, 1, Counter1)
End If
If (Worksheets("Laps").Cells(2, 5) = "West") Then
LapPositions(1, 2, Counter1) = -LapPositions(1, 2, Counter1)
LapPositions(2, 2, Counter1) = -LapPositions(2, 2, Counter1)
End If
End If
Counter1 = Counter1 + 1
Loop
' End of input capture
' Distance calculation for all targets vs all contacts
Counter1 = 1
Do While Counter1 <= NoDataSets
Counter2 = 1
Do While Counter2 <= NumberPositions(Counter1)
Counter3 = 1
Do While Counter3 <= NoDataSets
Counter4 = 1
Do While Counter4 <= NumberPositions(Counter3)
DVal1 = (Sin(Pi * (LatPosition(Counter2, Counter1) - LatPosition(Counter4, Counter3)) / 360)) ^ 2
DVal2 = Cos((Pi * LatPosition(Counter2, Counter1)) / 180) * Cos((Pi * LatPosition(Counter4, Counter3)) / 180) * ((Sin((Pi * (LongPosition(Counter2, Counter1) - LongPosition(Counter4, Counter3))) / 360)) ^ 2)
DVal3 = Atn((DVal1 + DVal2) / ((-(DVal1 + DVal2) * (DVal1 + DVal2) + 1) ^ 0.5))
Distances(Counter4, Counter3, Counter2, Counter1) = 2 * (DVal3 ^ 0.5) * (((6356752 * ((LatPosition(Counter2, Counter1) + LatPosition(Counter4, Counter3)) / 2) / 90) + (6378137 * (1 - (((LatPosition(Counter2, Counter1) + LatPosition(Counter4, Counter3)) / 2) / 90)))) * 1.09362)
Counter4 = Counter4 + 1
Loop
Counter3 = Counter3 + 1
Loop
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
' Based on the distance find the nearest neighbours
' Seeking smallest distance(counter2,2,counter1,1) between contacts counter2 and target counter1
Counter1 = 1
Do While Counter1 <= NumberPositions(1)
Counter2 = 1
MinDist = 99999
Do While Counter2 <= NumberPositions(2)
If (Distances(Counter2, 2, Counter1, 1) < MinDist) Then
MinDist = Distances(Counter2, 2, Counter1, 1)
MinName = Worksheets(Datasets(2)).Cells(Counter1 + 1, 1)
End If
Counter2 = Counter2 + 1
Loop
Worksheets("Targets").Cells(Counter1 + 1, 10) = MinName
Worksheets("Targets").Cells(Counter1 + 1, 11) = MinDist * (36 / 39) ' distance in metres after working in yards (historic)
Counter1 = Counter1 + 1
Loop
Counter2 = 1
Do While Counter2 <= NumberPositions(2)
Counter1 = 1
MinDist = 99999
Do While Counter1 <= NumberPositions(1)
If (Distances(Counter2, 2, Counter1, 1) < MinDist) Then
MinDist = Distances(Counter2, 2, Counter1, 1)
MinName = Worksheets(Datasets(1)).Cells(Counter1 + 1, 1)
End If
Counter1 = Counter1 + 1
Loop
Worksheets("Contacts").Cells(Counter2 + 1, 10) = MinName
Worksheets("Contacts").Cells(Counter2 + 1, 11) = MinDist * (36 / 39) ' distance in metres after working in yards (historic)
If (MinDist <= Worksheets("Targets").Cells(1, 1)) Then PCHit(Counter2) = 1
Counter2 = Counter2 + 1
Loop
'
Counter1 = 1
Do While Counter1 <= NumberPositions(1)
PCResult = PCResult + PCHit(Counter1)
Counter1 = Counter1 + 1
Loop
Worksheets("Contacts").Cells(1, 1) = 100 * PCResult / NumberPositions(1)
' X/Y calculations for Lap CPA and graphic output
MaxLat = -89.95
MinLat = 89.95
MaxLong = -179.95
MinLong = 179.95
Counter1 = 1
Do While Counter1 <= 1
Counter2 = 1
Do While Counter2 <= NumberPositions(Counter1)
If (LatPosition(Counter2, Counter1) >= MaxLat) Then MaxLat = LatPosition(Counter2, Counter1)
If (LatPosition(Counter2, Counter1) <= MinLat) Then MinLat = LatPosition(Counter2, Counter1)
If (LongPosition(Counter2, Counter1) >= MaxLong) Then MaxLong = LongPosition(Counter2, Counter1)
If (LongPosition(Counter2, Counter1) <= MinLong) Then MinLong = LongPosition(Counter2, Counter1)
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
Counter1 = 1
Do While Counter1 <= NoLaps
If (LapPositions(1, 1, Counter1) >= MaxLat) Then MaxLat = LapPositions(1, 1, Counter1)
If (LapPositions(1, 1, Counter1) <= MinLat) Then MinLat = LapPositions(1, 1, Counter1)
If (LapPositions(2, 1, Counter1) >= MaxLat) Then MaxLat = LapPositions(2, 1, Counter1)
If (LapPositions(2, 1, Counter1) <= MinLat) Then MinLat = LapPositions(2, 1, Counter1)
If (LapPositions(1, 2, Counter1) >= MaxLong) Then MaxLong = LapPositions(1, 2, Counter1)
If (LapPositions(1, 2, Counter1) <= MinLong) Then MinLong = LapPositions(1, 2, Counter1)
If (LapPositions(2, 2, Counter1) >= MaxLong) Then MaxLong = LapPositions(2, 2, Counter1)
If (LapPositions(2, 2, Counter1) <= MinLong) Then MinLong = LapPositions(2, 2, Counter1)
Counter1 = Counter1 + 1
Loop
MidLat = (MaxLat + MinLat) / 2
MidLong = (MaxLong + MinLong) / 2
' Distance calculation for targets, contacts and lap start/end in terms of X and Y from the MidLat and MidLong position
' Start with the targets and contacts
Counter1 = 1
Do While Counter1 <= NoDataSets
Counter2 = 1
Do While Counter2 <= NumberPositions(Counter1)
DVal1 = (Sin(Pi * (LatPosition(Counter2, Counter1) - MidLat) / 360)) ^ 2
DVal2 = Cos((Pi * LatPosition(Counter2, Counter1)) / 180) * Cos((Pi * MidLat) / 180) * ((Sin((Pi * 0) / 360)) ^ 2)
DVal3 = Atn((DVal1 + DVal2) / ((-(DVal1 + DVal2) * (DVal1 + DVal2) + 1) ^ 0.5))
YTargContDists(Counter2, Counter1) = 2 * (DVal3 ^ 0.5) * (((6356752 * ((LatPosition(Counter2, Counter1) + MidLat) / 2) / 90) + (6378137 * (1 - (((LatPosition(Counter2, Counter1) + MidLat) / 2) / 90)))) * 1.09362)
If (MidLat >= LatPosition(Counter2, Counter1)) Then YTargContDists(Counter2, Counter1) = -YTargContDists(Counter2, Counter1)
DVal1 = (Sin(Pi * (0) / 360)) ^ 2
DVal2 = Cos((Pi * MidLat) / 180) * Cos((Pi * MidLat) / 180) * ((Sin((Pi * (LongPosition(Counter2, Counter1) - MidLong)) / 360)) ^ 2)
DVal3 = Atn((DVal1 + DVal2) / ((-(DVal1 + DVal2) * (DVal1 + DVal2) + 1) ^ 0.5))
XTargContDists(Counter2, Counter1) = 2 * (DVal3 ^ 0.5) * (((6356752 * ((MidLat + MidLat) / 2) / 90) + (6378137 * (1 - (((MidLat + MidLat) / 2) / 90)))) * 1.09362)
If (MidLong >= LongPosition(Counter2, Counter1)) Then XTargContDists(Counter2, Counter1) = -XTargContDists(Counter2, Counter1)
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
' Then Lap start and end positions
Counter1 = 1
Do While Counter1 <= NoLaps
DVal1 = (Sin(Pi * (LapPositions(1, 1, Counter1) - MidLat) / 360)) ^ 2
DVal2 = Cos((Pi * LapPositions(1, 1, Counter1)) / 180) * Cos((Pi * MidLat) / 180) * ((Sin((Pi * 0) / 360)) ^ 2)
DVal3 = Atn((DVal1 + DVal2) / ((-(DVal1 + DVal2) * (DVal1 + DVal2) + 1) ^ 0.5))
XYLapPos(1, 1, Counter1) = 2 * (DVal3 ^ 0.5) * (((6356752 * ((LapPositions(1, 1, Counter1) + MidLat) / 2) / 90) + (6378137 * (1 - (((LapPositions(1, 1, Counter1) + MidLat) / 2) / 90)))) * 1.09362)
If (MidLat >= LapPositions(1, 1, Counter1)) Then XYLapPos(1, 1, Counter1) = -XYLapPos(1, 1, Counter1)
DVal1 = (Sin(Pi * (LapPositions(2, 1, Counter1) - MidLat) / 360)) ^ 2
DVal2 = Cos((Pi * LapPositions(2, 1, Counter1)) / 180) * Cos((Pi * MidLat) / 180) * ((Sin((Pi * 0) / 360)) ^ 2)
DVal3 = Atn((DVal1 + DVal2) / ((-(DVal1 + DVal2) * (DVal1 + DVal2) + 1) ^ 0.5))
XYLapPos(2, 1, Counter1) = 2 * (DVal3 ^ 0.5) * (((6356752 * ((LapPositions(2, 1, Counter1) + MidLat) / 2) / 90) + (6378137 * (1 - (((LapPositions(2, 1, Counter1) + MidLat) / 2) / 90)))) * 1.09362)
If (MidLat >= LapPositions(2, 1, Counter1)) Then XYLapPos(2, 1, Counter1) = -XYLapPos(2, 1, Counter1)
DVal1 = (Sin(Pi * (0) / 360)) ^ 2
DVal2 = Cos((Pi * MidLat) / 180) * Cos((Pi * MidLat) / 180) * ((Sin((Pi * (LapPositions(1, 2, Counter1) - MidLong)) / 360)) ^ 2)
DVal3 = Atn((DVal1 + DVal2) / ((-(DVal1 + DVal2) * (DVal1 + DVal2) + 1) ^ 0.5))
XYLapPos(1, 2, Counter1) = 2 * (DVal3 ^ 0.5) * (((6356752 * ((MidLat + MidLat) / 2) / 90) + (6378137 * (1 - (((MidLat + MidLat) / 2) / 90)))) * 1.09362)
If (MidLong >= LapPositions(1, 2, Counter1)) Then XYLapPos(1, 2, Counter1) = -XYLapPos(1, 2, Counter1)
DVal1 = (Sin(Pi * (0) / 360)) ^ 2
DVal2 = Cos((Pi * MidLat) / 180) * Cos((Pi * MidLat) / 180) * ((Sin((Pi * (LapPositions(2, 2, Counter1) - MidLong)) / 360)) ^ 2)
DVal3 = Atn((DVal1 + DVal2) / ((-(DVal1 + DVal2) * (DVal1 + DVal2) + 1) ^ 0.5))
XYLapPos(2, 2, Counter1) = 2 * (DVal3 ^ 0.5) * (((6356752 * ((MidLat + MidLat) / 2) / 90) + (6378137 * (1 - (((MidLat + MidLat) / 2) / 90)))) * 1.09362)
If (MidLong >= LapPositions(2, 2, Counter1)) Then XYLapPos(2, 2, Counter1) = -XYLapPos(2, 2, Counter1)
Counter1 = Counter1 + 1
Loop
' CPA between laps and all the targets
Counter1 = 1
Do While Counter1 <= NoLaps
Counter2 = 1
Do While Counter2 <= NumberPositions(1)
XStart = XYLapPos(1, 2, Counter1) - XTargContDists(Counter2, 1)
XEnd = XYLapPos(2, 2, Counter1) - XTargContDists(Counter2, 1)
YStart = XYLapPos(1, 1, Counter1) - YTargContDists(Counter2, 1)
YEnd = XYLapPos(2, 1, Counter1) - YTargContDists(Counter2, 1)
DVal1 = ((XStart * (XStart - XEnd)) + (YStart * (YStart - YEnd))) / (((XEnd - XStart) ^ 2) + ((YEnd - YStart) ^ 2))
If (DVal1 < 0) Then
CPA(Counter1, Counter2) = ((XStart ^ 2) + (YStart ^ 2)) ^ 0.5
ElseIf (DVal1 > 1) Then
CPA(Counter1, Counter2) = ((XEnd ^ 2) + (YEnd ^ 2)) ^ 0.5
Else
CPA(Counter1, Counter2) = (((XStart + (DVal1 * (XEnd - XStart))) ^ 2) + ((YStart + (DVal1 * (YEnd - YStart))) ^ 2)) ^ 0.5
End If
'DELETE*** Worksheets("CheckSum").Cells(40 + Counter1, Counter2 + 1) = CPA(Counter1, Counter2)
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
Counter3 = 1
Counter1 = 1
Do While Counter1 <= NoLaps
Counter2 = 1
Do While Counter2 <= NumberPositions(1)
If (CPA(Counter1, Counter2) <= Worksheets("Laps").Cells(1, 3) * Sin(Pi * Worksheets("Laps").Cells(1, 6) / 360) * (39 / 36)) Then
Worksheets("Laps").Cells(Counter1 + 2, Counter3 + 15) = Worksheets(Datasets(1)).Cells(Counter2 + 1, 1)
Counter3 = Counter3 + 1
End If
Counter2 = Counter2 + 1
Loop
Counter3 = 1
Counter1 = Counter1 + 1
Loop
' Write out the graphic data
Counter1 = 1
Do While Counter1 <= MaxContacts
Counter2 = 1
Do While Counter2 <= 8
Worksheets("Graphic").Cells(Counter1, Counter2) = ""
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
Counter1 = 1
Do While Counter1 <= NumberPositions(1)
Worksheets("Graphic").Cells(Counter1, 1) = XTargContDists(Counter1, 1)
Worksheets("Graphic").Cells(Counter1, 2) = YTargContDists(Counter1, 1)
Counter1 = Counter1 + 1
Loop
Counter1 = 1
Do While Counter1 <= NumberPositions(2)
Worksheets("Graphic").Cells(Counter1, 4) = XTargContDists(Counter1, 2)
Worksheets("Graphic").Cells(Counter1, 5) = YTargContDists(Counter1, 2)
Counter1 = Counter1 + 1
Loop
Counter1 = 1
Do While Counter1 <= NoLaps
Worksheets("Graphic").Cells((2 * Counter1) - 1, 7) = XYLapPos(1, 2, Counter1)
Worksheets("Graphic").Cells((2 * Counter1) - 0, 7) = XYLapPos(2, 2, Counter1)
Worksheets("Graphic").Cells((2 * Counter1) - 1, 8) = XYLapPos(1, 1, Counter1)
Worksheets("Graphic").Cells((2 * Counter1) - 0, 8) = XYLapPos(2, 1, Counter1)
Counter1 = Counter1 + 1
Loop
' Start writing output table
' Clear cells
Counter1 = 1
Do While Counter1 <= 2 * (MaxDataSets + MaxContacts)
Counter2 = 1
Do While Counter2 <= 2 * (MaxDataSets + MaxContacts)
Worksheets("Output").Cells(Counter2, Counter1) = ""
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
' Titles for rows and columns
RowCount = 0
Worksheets("Output").Cells(3, 1) = Datasets(1)
Counter1 = 1
Do While Counter1 <= NumberPositions(1)
Worksheets("Output").Cells(Counter1 + 2, 2) = Worksheets(Datasets(1)).Cells(Counter1 + 1, 1)
Counter1 = Counter1 + 1
Loop
RowCount = RowCount + NumberPositions(1) + 3
Counter1 = NoDataSets
Do While Counter1 >= 3
Worksheets("Output").Cells(RowCount, 1) = Datasets(Counter1)
Counter2 = 1
Do While Counter2 <= NumberPositions(Counter1)
Worksheets("Output").Cells(RowCount + Counter2 - 1, 2) = Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 1)
Counter2 = Counter2 + 1
Loop
RowCount = RowCount + NumberPositions(Counter1)
Counter1 = Counter1 - 1
Loop
ColumnCount = 2
Counter1 = 2
Do While Counter1 <= NoDataSets
Worksheets("Output").Cells(1, ColumnCount + 1) = Datasets(Counter1)
Counter2 = 1
Do While Counter2 <= NumberPositions(Counter1)
Worksheets("Output").Cells(2, ColumnCount + Counter2) = Worksheets(Datasets(Counter1)).Cells(Counter2 + 1, 1)
Counter2 = Counter2 + 1
Loop
ColumnCount = ColumnCount + NumberPositions(Counter1)
Counter1 = Counter1 + 1
Loop
' Output for the first dataset
RowCount = 2
Counter1 = 1
Do While Counter1 <= NumberPositions(1)
ColumnCount = 2
Counter2 = 2
Do While Counter2 <= NoDataSets
Counter3 = 1
Do While Counter3 <= NumberPositions(Counter2)
Worksheets("Output").Cells(RowCount + Counter1, ColumnCount + Counter3) = Distances(Counter3, Counter2, Counter1, 1) * (36 / 39) ' With 36/39 conversion from yards to metres
Counter3 = Counter3 + 1
Loop
ColumnCount = ColumnCount + NumberPositions(Counter2)
Counter2 = Counter2 + 1
Loop
Counter1 = Counter1 + 1
Loop
' Output for the other data set rows
RowCount = RowCount + NumberPositions(1)
ColumnCount = 2
Counter1 = NoDataSets
Do While Counter1 >= 3
Counter2 = 2
Do While Counter2 < Counter1
Counter3 = 1
Do While Counter3 <= NumberPositions(Counter1)
Counter4 = 1
Do While Counter4 <= NumberPositions(Counter2)
Worksheets("Output").Cells(RowCount + Counter3, ColumnCount + Counter4) = Distances(Counter4, Counter2, Counter3, Counter1) * (36 / 39) ' With 36/39 conversion from yards to metres
Counter4 = Counter4 + 1
Loop
Counter3 = Counter3 + 1
Loop
ColumnCount = ColumnCount + NumberPositions(Counter2)
Counter2 = Counter2 + 1
Loop
RowCount = RowCount + NumberPositions(Counter1)
Counter1 = Counter1 - 1
ColumnCount = 2
Loop
' End of output file writing
End Sub
推荐答案
史蒂夫，
我建议你尝试下面的链接看看磨她符合你的要求。
I suggest you try link below to see whether it meet your requirement.
https：/ /gallery.technet.microsoft.com/office/Progressbar-How-does-it-68254b8f
最好的问候，
这篇关于在计算过程中显示进度条的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
