XL 2010 Traitement Boucle IF trop long

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Maxado56

XLDnaute Nouveau
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
 
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+
 
Dernière édition:
Re,

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

Le code dans Module1 :
Code:
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+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
526
Réponses
9
Affichages
600
  • Question Question
Microsoft 365 colorer une plage
Réponses
2
Affichages
872
Réponses
22
Affichages
3 K
Réponses
8
Affichages
1 K
Retour