XL 2010 Traitement Boucle IF trop long

[Maxado56]

Bonjour à tous,
J'ai besoin de votre aide pour un sujet de procédure assez longue pour une boucle IF
NblBase1 est le nombre de ligne à traiter, au début il y en avait 5 mais maintenant 50 et cela va augmenter, donc le traitement également
Existe t-il une solution afin d'accélérer le traitement (j'ai déjà essayé une boucle do loop, et application.screenupdating)

Voici le code simplifié en question ci-dessous:

For LigneActBase1 = 2 To NblBase1
ConcatenerBase2 = Sheets("Base2").Cells(LigneActBase2, 1) & Sheets("Base2").Cells(LigneActBase2, 2)
ConcatenerBase1 = Sheets("Base1").Cells(LigneActBase1, 1) & Sheets("Base1").Cells(LigneActBase1, 2)
If ConcatenerBase1 = ConcatenerBase2 Then
'mise en gris des camions du jour expédiés
ActiveCell.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.PatternTintAndShade = 0
End With
End If
Next LigneActBase1

Merci de votre aide

 

[pierrejean]

Bonjour

Un fichier exemple (sans données confidentielles ) nous aiderait à t'aider

 

[ChTi160]

Bonjour Maxado56
Bonjour le Fil ,(pierrejean),le Forum
Dans la Boucle

 For LigneActBase1 = 2 To NblBase1

à quoi est égale "LigneActBase2"
jean marie

 

[job75]

Bonjour Maxado56, Pierre, Jean-Marie,

D'après ce que je comprends il s'agit de colorer les concaténations identiques en feuilles "Base1" et "Base2".

La meilleure solution est d'utiliser des MFC pilotées en VBA par des Dictionary mémorisés.

Edit : eh bien non, le fichier que j'avais joint se vérolait : la macro Workbook_Open ne se déclenchait plus !

J'ai donc supprimé ce fichier, il faudra trouver autre chose.

A+

 

[job75]

Re,

Bon j'y suis arrivé avec une colonne auxiliaire (masquée) dans chaque feuille du fichier joint.

Le code dans Module1 :

Public dico1 As Object, dico2 As Object 'mémorise les variables

Function Doublon1(txt As String) As Boolean
Application.Volatile
Doublon1 = dico2.exists(txt)
End Function

Function Doublon2(txt As String) As Boolean
Application.Volatile
Doublon2 = dico1.exists(txt)
End Function

Sub Calcul_dico1()
Dim tablo, i&
With Sheets("Base1").[B1].CurrentRegion 'à adapter
    tablo = .Value
    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tablo)
        dico1(tablo(i, 1) & tablo(i, 2)) = ""
    Next
    .Columns(3).EntireColumn.ClearContents 'RAZ
    .Columns(3) = "=Doublon1(RC[-2]&RC[-1])"
End With
End Sub

Sub Calcul_dico2()
Dim tablo, i&
With Sheets("Base2").[C1].CurrentRegion 'à adapter
    tablo = .Value
    Set dico2 = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tablo)
        dico2(tablo(i, 1) & tablo(i, 2)) = ""
    Next
    .Columns(3).EntireColumn.ClearContents 'RAZ
    .Columns(3) = "=Doublon2(RC[-2]&RC[-1])"
End With
End Sub

Les macros Workbook_Open et Worksheet_Change recalculent les Dictionary.

A+

 

[mapomme]

Bonjour @Maxado56, @pierrejean , @job75 ,

La même via une MFC de type formule (sans doute plus lente en cas de très nombreuses lignes de données). Voir fichier joint.