Simplifier une macro

yannlion

XLDnaute Junior
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:D" & 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:

Jam

XLDnaute Accro
Re : [xl 2010] Simplifier une macro

Bonjour yannlion,

pas le temps de me pencher sur ton code aujourd'hui, néanmoins il faut savoir que travailler avec des cellules est très consommateur de temps. Il faut, dans la mesure du possible utiliser des tableaux.
Petit point, tu peux mettre
Code:
  Application.Calculation=xlCalculationManual
en début de module, ce qui devrait accélérer en partie ton code.

Bon courage.
 

yannlion

XLDnaute Junior
Re : Simplifier une macro

Bonsoir,

En fait voilà ce que j'ai tenté de faire avec ma macro.
1) Remplacer toutes les cellules vides par celle situé plus haut non vide et supprimer celles qui ne sont pas utiles
2) Vérifier que pour chaque ligne de l'onglet EBP, on retrouve une ligne dans la plage de l'onglet BUDGETDEATIL une même ligne avec le même poste et le même compte. Si je la retrouve je saisi "OK" en colonne O sinon "Pas OK".
3) mettre la ligne "PAS OK" avec un fond rouge (je le ferai après !)

J'ai réussi mais l'exécution est lourde ...
Peut être dû au nombre conséquent de SOMMEPROD dans le deuxième onglet ;)

Merci d'avance à celui qui me permettra de gagner du temps !

Bonne soirée
Yannlion
 
Dernière édition:

Jam

XLDnaute Accro
Re : Simplifier une macro

Salut yannlion,

Je reviens sur ton code.
Pour la partie 1) remplissage des lignes vides par le contenu de la cellule "pleine" du dessus j'ai ta solution. Tu trouveras le code que j'utilise sur des tableaux de plusieurs milliers de ligne pour faire cette chose. Son résultat est quasi instantané. C'est un utilitaire que j'ai développé qui fait cela pour une ou plusieurs colonnes et dans les 2 sens (de bas en haut ou inversement...).
Son fonctionnement est particulièrement simple: tu sélectionnes la plage que tu veux remplir et tu lances la macro.
A adapter à ton cas, hein ;)

Le code:
VB:
'********************************************************************
' Remplace les cellules vides par la valeur de la première
' cellule non vide immédiatement au-dessus ou au-dessous.
' Cette procédure parcours la sélection de HAUT en BAS et inversement
' ATTENTION : Cette procédure utilise la sélection en cours
'********************************************************************
Sub FillEmptyLinesWithValue()
Dim i As Long
Dim j As Long
Dim nbColonnes As Long
Dim Start As Long
Dim Finish As Long
Dim TopBot As Byte
Dim Direction As Integer
Dim MyArray, Valeur As Variant
Dim MyRange As Range
Dim Msg As String


On Error GoTo GestionErreur


With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


Set MyRange = Selection
With MyRange
    nbColonnes = .Columns.Count
    MyArray = .Value
End With


Msg = "Pour effectuer un remplacement de " & vbCr
Msg = Msg & "HAUT en BAS cliquer sur le bouton OUI" & vbCr
Msg = Msg & "BAS en HAUT cliquer sur le bouton NON"
TopBot = MsgBox(Msg, vbYesNoCancel + vbQuestion, TITLE)
Select Case TopBot
    Case vbCancel
        End
    Case vbYes
        Start = 1: Finish = UBound(MyArray, 1): Direction = 1
    Case Else
        Start = UBound(MyArray, 1): Finish = 1: Direction = -1
End Select
For i = 1 To nbColonnes
    Valeur = ""
    For j = Start To Finish Step Direction
        Select Case VarType(MyArray(j, i))
            Case vbEmpty
                MyArray(j, i) = Valeur
            Case Else
                Valeur = MyArray(j, i)
        End Select
    Next
Next
MyRange.Value = MyArray
GestionErreur:
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Bon courage.

PS./ Si j'ai un peu de temps je regarderai pour la suite...
 

yannlion

XLDnaute Junior
Re : Simplifier une macro

Bonjour Jam,

Tout simplement génial ! C'est bluffant tellement c'est rapide.
Je l'ai un peu modifié mais je bloque sur le changement de sélection (Set MyRange =).

Code VBA :

Code:
Sub FillEmptyLinesWithValue()
Dim i As Long
Dim j As Long
Dim nbColonnes As Long
Dim Finish As Long
Dim TopBot As Byte
Dim MyArray, Valeur As Variant
Dim MyRange As Range


On Error GoTo GestionErreur


With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


Set MyRange = Selection 'voudrais changer par Range("A1:D" & .Range("E65536").End(xlUp).Row).select ?'
With MyRange
    nbColonnes = .Columns.Count
    MyArray = .Value
End With

For i = 1 To nbColonnes
    Valeur = ""
    For j = 1 To UBound(MyArray, 1) Step 1
        Select Case VarType(MyArray(j, i))
            Case vbEmpty
                MyArray(j, i) = Valeur
            Case Else
                Valeur = MyArray(j, i)
        End Select
    Next
Next
MyRange.Value = MyArray
GestionErreur:
With Application
    .ScreenUpdating = True
End With
End Sub

Une idée ?
Sinon je continue avec l'étape suivante : supprimer toutes les lignes dont la cellule en colonne G est vide :confused:

Merci
Yannlion
 

Statistiques des forums

Discussions
312 923
Messages
2 093 663
Membres
105 779
dernier inscrit
le routier