- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
-
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Sub Raporla()
'Dim wfTOPLA As WorksheetFunction: Set wfTOPLA = WorksheetFunction.Sum
Dim wsRAPR, wsOZET As Worksheet: Set wsRAPR = Sheets("2007"): Set wsOZET = Sheets("ozet")
UserForm1.Show False: DoEvents
Application.Calculation = xlCalculationManual
For sat = 8 To 140
topla = 0
If wsOZET.Cells(sat, "K") <> "" And _
wsOZET.Cells(sat, "R") <> "" And _
wsOZET.Cells(sat, "F") <> "" Then
For rpr = 5 To 2262
If wsRAPR.Cells(rpr, "E") = wsOZET.Cells(sat, "K") And _
wsRAPR.Cells(rpr, "F") = wsOZET.Range("C4") And _
wsRAPR.Cells(rpr, "B") >= wsOZET.Range("I4") And _
wsRAPR.Cells(rpr, "B") <= wsOZET.Range("M4") And _
UCaseTr(wsRAPR.Cells(rpr, "G")) = UCaseTr(wsOZET.Cells(sat, "R")) And _
UCaseTr(wsRAPR.Cells(rpr, "I")) = UCaseTr(wsOZET.Cells(sat, "F")) Then
topla = topla + wsRAPR.Cells(rpr, "J")
End If
Next rpr
wsOZET.Cells(sat, "M") = topla
Else
wsOZET.Cells(sat, "M") = ""
End If
Next sat
Application.Calculation = xlCalculationAutomatic
Unload UserForm1
MsgBox "Veri Aktarımı Başarı ile tamamlandı."
End Sub
Function UCaseTr(ByVal metin As String)
UCaseTr = UCase(Replace(Replace(metin, "ı", "I"), "i", "İ"))
End Function
webbrowsera eklediğim gif hareket etmiyor normalde ediyor (modülden çağırmassam) ne yapmalıyım. ayrıca label2 de geçen sürede yazmaya devam etsin
00:00:00,00:00:01,00:00:02..........00:00:10........00:01:01 vs.