[Tarkan VURAL]

Bir örnek daha, bu defaki ProgressBar' ın kendisi ile ...

Kod: Tümünü seç

Private Sub UserForm_activate()
On Error Resume Next
ProgressBar1.Max = Sayfa1.Range("a65536").End(3).Row
Dim Sayac As Long, i As Long
Sayac = 1
For i = 2 To Range("a65536").End(3).Row
Cells(1, "H") = "Miktar"
Cells(i, "H") = WorksheetFunction.Sum(Cells(i, 1) * Cells(i, 2))
Sayac = Sayac + 1
UserForm1.ProgressBar1.Value = Sayac
UserForm1.Label1.Caption = Sayac & " adet işlem tamamlandı ....."
DoEvents
Next i
Unload UserForm1
End Sub

[Tarkan VURAL]

Farklı bir örnek daha ;
UserFormu kapatsanız da hücrede sayım devam ediyor...

[Tarkan VURAL]

Karışık işlemler için bir ProgressBar örneği daha ...

Kod: Tümünü seç

Sub Deneme()
On Error Resume Next
Dim i As Long, a As Long
ProgressBar1.Max = Sayfa1.Range("a65536").End(3).Row
Range("A1:B5001").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F1"), Unique:=True
Columns("F:G").Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:=Range("G2"), _
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Range("F1").Select
a = Range("F65536").End(3).Row
For i = 2 To a
Cells(1, "H") = "Miktar"
UserForm1.ProgressBar1.Value = i
UserForm1.Label1.Caption = "İlerleme Durumu : " & CInt(i / (a / 100)) & "%" & vbCr & _
vbCr & vbCr & "Yapılan İşlem Adedi : " & i
Cells(i, "H") = Evaluate("=SUMPRODUCT(($A$2:$A$5001=F" & i & ")*($B$2:$B$5001=G" & i & ")*($C$2:$C$5001))")
DoEvents
Next
Unload UserForm1
Range("h65536").End(3).Select
End Sub

[Erkan Akayay]

Tarkan inat ettin ve yaptın , helal olsun Progressbardan özür dilerim

[Tarkan VURAL]

Tarkan inat ettin ve yaptın , helal olsun Progressbardan özür dilerim

Senin yüzünden, ProgressBar' ı kötüledin, o da dokundu bana