|
hallo zusammen,
ich habe ein performance Problem meines VBA codes. ich benutze viele Sverweise und summewenn Funktionen. jetzt stehe ich vor einem Lange Zeit der Ausführung. kann jemanden mir helfen?
Sub consolidation_de()
Dim bereich As Range
Dim srchRange As Range, srchrange1 As Range, srchrange2 As Range
Dim lastr As Long
Dim lastc As Long
Dim i As Integer
Dim N As Integer
Dim M As Integer
' start
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
lastr = Sheets("paie").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Contrôle Coherence").Range("A2:AE65000").ClearContents
Sheets("paie").Select
Columns("A:A").Select
Selection.Copy
Sheets("Contrôle Coherence").Select
Columns("A:A").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Set bereich = Sheets("Contrôle Coherence").Range("A2:A" & Cells(65536, 1).End(xlUp).Row)
'range=admin range2=paie
Set adminarr = Sheets("admin").Range("A:AU")
Set paiearr = Sheets("Paie").Range("A:L")
Set mat_rng = Sheets("horaire").Range("C:C") 'matricules
Set mat_rng_abs = Sheets("Absences").Range("E:E")
Set heures_rng = Sheets("Absences").Range("Q:Q") 'ticket restaurant
'Set heurestheo_rng = Sheets("horaire").Range("N:N")
'Set heurestrava_rng = Sheets("horaire").Range("O:O")
Set Ticketresto = Sheets("horaire").Range("J:J")
Set TitreNour = Sheets("horaire").Range("K:K")
'Set heuressup = Sheets("horaire").Range("P:P")
Set Abs_primes_salissure = Sheets("absences").Range("R:R") 'absence primes de salissure
Set jour_travail = Sheets("horaire").Range("M:M")
Set jour_absence = Sheets("absences").Range("L:L")
Set jour_ouvres = Sheets("horaire").Range("N:N")
'Set MATJOURABS = Sheets("Absences").Range("T:T")
Set jour_abs_PrP = Sheets("Absences").Range("Q:Q")
Set Mat_range1 = Sheets("Perte SS").Range("B:B")
Set nbre_maintenu = Sheets("Perte SS").Range("H:H")
Set MTT_maintenu = Sheets("Perte SS").Range("I:I")
Set Mat_range2 = Sheets("Perte SS").Range("K:K")
Set nbre_retenue = Sheets("Perte SS").Range("Q:Q")
Set MTT_retenue = Sheets("Perte SS").Range("R:R")
Set srchRange3 = Sheets("Perte SS").Range("K:S")
' Set srchrange4 = Sheets("Paie Nombre").Range("A:T")
Set mat_TNRAZ = Sheets("TNRAZ").Range("A:A")
Set TNRAZ = Sheets("TNRAZ").Range("H:H")
Set mat_cantine = Sheets("TNTR NEG CANTINE").Range("A:A")
Set CANTINE = Sheets("TNTR NEG CANTINE").Range("H:H")
Set Mois_entier_présence = Sheets("Absences").Range("V:V")
lastr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
' process
With Application
For i = 1 To lastr
bereich.Cells(i, 1).Offset(0, 1).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 5, 0)
bereich.Cells(i, 1).Offset(0, 2).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 6, 0)
bereich.Cells(i, 1).Offset(0, 3).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 10, 0)
bereich.Cells(i, 1).Offset(0, 4).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 12, 0)
bereich.Cells(i, 1).Offset(0, 5).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 4, 0)
'primes de presence
bereich.Cells(i, 1).Offset(0, 6).Value = _
.VLookup(bereich.Cells(i, 1).Value, paiearr, 2, 0)
bereich.Cells(i, 1).Offset(0, 7).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 19, 0)
bereich.Cells(i, 1).Offset(0, 8).Value = _
.SumIf(mat_rng_abs, bereich.Cells(i, 1).Value, jour_abs_PrP)
bereich.Cells(i, 1).Offset(0, 9).Value = _
.SumIf(mat_rng, bereich.Cells(i, 1).Value, jour_travail)
bereich.Cells(i, 1).Offset(0, 59).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 17, 0)
bereich.Cells(i, 1).Offset(0, 12).Value = _
.SumIf(mat_rng_abs, bereich.Cells(i, 1).Value, Mois_entier_présence)
'ticket restaurants
bereich.Cells(i, 1).Offset(0, 14).Value = _
.VLookup(bereich.Cells(i, 1).Value, paiearr, 8, 0) ' ticket restaurant paie
bereich.Cells(i, 1).Offset(0, 15).Value = _
.SumIf(mat_rng, bereich.Cells(i, 1).Value, Ticketresto)
bereich.Cells(i, 1).Offset(0, 16).Value = _
.SumIf(mat_TNRAZ, bereich.Cells(i, 1).Value, TNRAZ) ' TNRAZ
bereich.Cells(i, 1).Offset(0, 17).Value = _
.SumIf(mat_cantine, bereich.Cells(i, 1).Value, CANTINE) ' CANTINE
bereich.Cells(i, 1).Offset(0, 18).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 45, 0) ' droit des tickets
If bereich.Cells(i, 1).Offset(0, 18).Value = "TR" Then
bereich.Cells(i, 1).Offset(0, 15).Value = _
.SumIf(mat_rng, bereich.Cells(i, 1).Value, Ticketresto)
ElseIf bereich.Cells(i, 1).Offset(0, 18).Value <> "TR" Then
bereich.Cells(i, 1).Offset(0, 15).Value = _
.SumIf(mat_rng, bereich.Cells(i, 1).Value, TitreNour)
End If
'cotisation
bereich.Cells(i, 1).Offset(0, 22).Value = _
.VLookup(bereich.Cells(i, 1).Value, paiearr, 5, 0) 'salaire Brut
bereich.Cells(i, 1).Offset(0, 23).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 46, 0) 'taux de carge patronale
bereich.Cells(i, 1).Offset(0, 24).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 47, 0) 'taux de charge salariale
bereich.Cells(i, 1).Offset(0, 25).Value = _
.VLookup(bereich.Cells(i, 1).Value, paiearr, 10, 0) 'patronale
bereich.Cells(i, 1).Offset(0, 26).Value = _
.VLookup(bereich.Cells(i, 1).Value, paiearr, 6, 0) 'salariale
'primes de salissures
bereich.Cells(i, 1).Offset(0, 30).Value = _
.VLookup(bereich.Cells(i, 1).Value, paiearr, 7, 0)
bereich.Cells(i, 1).Offset(0, 31).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 26, 0) 'droit de salissure
bereich.Cells(i, 1).Offset(0, 32).Value = _
.SumIf(mat_rng_abs, bereich.Cells(i, 1).Value, Abs_primes_salissure) 'absence prime de salissure
bereich.Cells(i, 1).Offset(0, 33).Value = _
.VLookup(bereich.Cells(i, 1).Value, adminarr, 2, 0)
'perte sur salaire
bereich.Cells(i, 1).Offset(0, 38).Value = _
.SumIf(Mat_range1, bereich.Cells(i, 1).Value, nbre_maintenu)
bereich.Cells(i, 1).Offset(0, 39).Value = _
.SumIf(Mat_range1, bereich.Cells(i, 1).Value, MTT_maintenu)
bereich.Cells(i, 1).Offset(0, 40).Value = _
.SumIf(Mat_range2, bereich.Cells(i, 1).Value, nbre_retenue)
bereich.Cells(i, 1).Offset(0, 41).Value = _
.SumIf(Mat_range2, bereich.Cells(i, 1).Value, MTT_retenue)
bereich.Cells(i, 1).Offset(0, 42).Value = _
.VLookup(bereich.Cells(i, 1).Value, srchRange3, 9, 0)
'IPRIAC
bereich.Cells(i, 1).Offset(0, 47).Value = _
.VLookup(bereich.Cells(i, 1).Value, paiearr, 11, 0)
bereich.Cells(i, 1).Offset(0, 51).Value = _
.SumIf(mat_rng, bereich.Cells(i, 1).Value, jour_ouvres)
On Error Resume Next
Next i
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
MsgBox "Master est fini"
End Sub
vielen Dank im Voraus!
Viele Grüße!
Imed
|