我的进度条不起作用,我不知道如何显示进度标签
我已经尝试修改循环的结束位置
Sub ShowUserForm()
UserForm1.Show
End Sub
Sub Main()
Dim Counter As Integer
Dim PctDone As Single
Dim RngToCheck As Range, RngToPaste As Range
Set RngToCheck = Application.InputBox(Prompt:="Enter range", Type:=8)
Dim inttofind As String
inttofind = InputBox("Give your indicator")
Application.ScreenUpdating = False
Counter = 1
Dim i As Long
For i = RngToCheck.Rows.Count To 1 Step -1
If RngToCheck(i).Value = inttofind Then
RngToCheck(i).Offset(1).EntireRow.Insert
Set RngToPaste = RngToCheck(i).Offset(1)
CopyAlmostEntireRow RngToCheck(i), RngToPaste
RngToPaste.EntireRow.Font.Color = RGB(255, 0, 0)
Counter = Counter + 1
End If
Next i
PctDone = i / RngToCheck.Rows.Count
UpdateProgressBar PctDone
Unload UserForm1
End Sub
Sub UpdateProgressBar(PctDone As Single)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * _
(.FrameProgress.Width - 10)
End With
DoEvents
End Sub
Sub CopyAlmostEntireRow(FromRow As Range, ToRow As Range)
Dim FromRange As Range
Dim ToRange As Range
Set FromRange = FromRow.Worksheet.Range("A" & FromRow.Row & ":AR" & FromRow.Row)
Set ToRange = ToRow.Worksheet.Range("A" & ToRow.Row & ":AR" & ToRow.Row)
ToRange.Value = FromRange.Value
Set FromRange = FromRow.Worksheet.Range("AV" & FromRow.Row & ":ED" & FromRow.Row)
Set ToRange = ToRow.Worksheet.Range("AV" & ToRow.Row & ":ED" & ToRow.Row)
ToRange.Value = FromRange.Value
End Sub