Bonjour à tous,
Après de nombreuses soirées à chercher sur les forums à écrire une macro, j'ai réussi à sortir quelque chose !!!
Le souci : le calcul est très long et je me demande s'il n'y a pas possibilité de la simplifier afin de rendre son exécution plus rapide.
Merci d'avance à l'expert en vba qui trouvera la solution
Voici le code :
Sub EBP()
Application.ScreenUpdating = False
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each sel In Selection
sel.FormulaR1C1 = "=R[-1]C"
sel.Value = sel.Value
Next sel
Dim i As Integer, DerniereLigne As Integer
DerniereLigne = Range("E65536").End(xlUp).Row
For i = DerniereLigne To 1 Step -1
If Worksheets("EBP").Cells(i, 7) = "" Then Worksheets("EBP").Rows(i).Delete
Next i
Dim Rg As Range
With Sheets("EBP")
Set Rg = .Range("E1:E" & .Range("E65536").End(xlUp).Row)
End With
For a = Rg.Rows.Count To 1 Step -1
If Application.CountIf(Rg(a).EntireRow, "01/01/1000") > 0 Then
Rg(a).EntireRow.Delete
End If
Next
Dim cel As Range
For Each cel In Range("E1:E" & Range("E65536").End(xlUp).Row)
cel = Right(cel, 7)
Next cel
End Sub
Sub EBP2()
Dim Plage1 As Range, Plage2 As Range
Dim x As Long, y As Long, maxEPB As Long, maxbudget As Long
With Sheets("EBP")
maxEBP = .Range("A" & .Rows.Count).End(xlUp).Row
Set Plage1 = .Range("A1:C" & maxEBP)
End With
With Sheets("BUDGETDETAIL")
maxbudget = .Range("D" & .Rows.Count).End(xlUp).Row
Set Plage2 = .Range("B4" & maxbudget)
For x = 1 To maxEBP
For y = 1 To maxbudget
chaine1 = Plage1(x, 1) & Plage1(x, 3)
chaine2 = Plage2(y, 1) & Plage2(y, 3)
If chaine1 = chaine2 Then Sheets("EBP").Range("O" & x) = "OK"
Next y
Next x
End With
End Sub
Bonne journée
Yannlion
Après de nombreuses soirées à chercher sur les forums à écrire une macro, j'ai réussi à sortir quelque chose !!!
Le souci : le calcul est très long et je me demande s'il n'y a pas possibilité de la simplifier afin de rendre son exécution plus rapide.
Merci d'avance à l'expert en vba qui trouvera la solution
Voici le code :
Sub EBP()
Application.ScreenUpdating = False
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each sel In Selection
sel.FormulaR1C1 = "=R[-1]C"
sel.Value = sel.Value
Next sel
Dim i As Integer, DerniereLigne As Integer
DerniereLigne = Range("E65536").End(xlUp).Row
For i = DerniereLigne To 1 Step -1
If Worksheets("EBP").Cells(i, 7) = "" Then Worksheets("EBP").Rows(i).Delete
Next i
Dim Rg As Range
With Sheets("EBP")
Set Rg = .Range("E1:E" & .Range("E65536").End(xlUp).Row)
End With
For a = Rg.Rows.Count To 1 Step -1
If Application.CountIf(Rg(a).EntireRow, "01/01/1000") > 0 Then
Rg(a).EntireRow.Delete
End If
Next
Dim cel As Range
For Each cel In Range("E1:E" & Range("E65536").End(xlUp).Row)
cel = Right(cel, 7)
Next cel
End Sub
Sub EBP2()
Dim Plage1 As Range, Plage2 As Range
Dim x As Long, y As Long, maxEPB As Long, maxbudget As Long
With Sheets("EBP")
maxEBP = .Range("A" & .Rows.Count).End(xlUp).Row
Set Plage1 = .Range("A1:C" & maxEBP)
End With
With Sheets("BUDGETDETAIL")
maxbudget = .Range("D" & .Rows.Count).End(xlUp).Row
Set Plage2 = .Range("B4" & maxbudget)
For x = 1 To maxEBP
For y = 1 To maxbudget
chaine1 = Plage1(x, 1) & Plage1(x, 3)
chaine2 = Plage2(y, 1) & Plage2(y, 3)
If chaine1 = chaine2 Then Sheets("EBP").Range("O" & x) = "OK"
Next y
Next x
End With
End Sub
Bonne journée
Yannlion
Dernière édition: