Microsoft 365 Simplification de code

GADENSEB

GADENSEB

XLDnaute Impliqué
Bonjour,

Je perfectionne mon fichier de gestion de finances perso.

J'en suis à un stade d'import des datas depuis la banque.

De cet import je catégorise les flux sur mes comptes en type de dépenses et recettes.

Grace à une formule matricielle (crée grâce à ce forum d'ailleurs merci). je consulte une DB pour la reconnaissance
des libellés des différentes lignes sur mon compte.
Formule :
"=IF(ISNA(VLOOKUP(RC[-1],DATABUDGET,2,FALSE)),INDEX(DATABUDGET[LIBELLE],MAX(IF(ISNUMBER(SEARCH(DATABUDGET[ORIGINE],RC[-1])),ROW(DATABUDGET[LIBELLE])-1,0)),),VLOOKUP(RC[-1],DATABUDGET,2,FALSE))"
Cela fonctionne assez bien, avec 80 90% de reconnaissance.
De ce résultat, dépend d'autres formules pour obtenir le formalise de databae souhaitée.

L'ensemble des résultats sera déplacé dans la database principale, après vérification de l'ensemble des lignes.


Sur le traitement que je suis entrain de faire, j'ai 3000 lignes.
Et c'est assez longtemps de faire l'ensemble des calculs.
3000 lignes, pour des calculs sur environ 15 colonnes

cela pendre en 10 et 15 minutes.

...........C'est trés long................

j'ai crée le code suivant.
je pense qu'il n'ai pas optimiser et c'est pour quoi c'est long.............. lol

est-ce que qqn aurait une idée pour le simplifier et l'accélerer ???

Je ne peux pas diffuser mon fichier comme c'est mes comptes persos :)
J'ai mis annotations dans le code.

Pour Résumer le code:
1-Je rècupère les datas sur l'onglet "IMPORT"
2-Je les colles dans l'onglet "CONVERSION"
3-J'installe les formules sur toutes les lignes et les colonnes.
4-Je fige les résultats.
5-Un peu de mise en page.

Ce qui me manque :
- Accélerer le code lol
- Ne figer les résultats que sur les lignes dont la colonne AA ="OUI"
- Si la collone AA passe à "OUI" alors je fige les résultats de la ligne
- Si la collone AA passe à "NON" alors je réinstalle les formules commme sur l'étape 3

je pense que je me suis un peu perdu dans tout mon code lol

Bonne journée

Sébastien



VB: 
Sub ConversionImport()
Dim L%
Dim X%

Dim cellule As Range



'Je récupére le nombre max de la DATABASE
X = Application.Max(Worksheets("COMPTES").Range("A1:A99999"))

'Je bloque les calcul sur certaines feuilles
Worksheets("DATA").EnableCalculation = False
Worksheets("CONVERSION").EnableCalculation = False

'--------------------------------------------------------Initialisation de la page
'Je vide la page Concernée


With Sheets("CONVERSION")

L = .[w65000].End(xlUp).Row


.Range("A2:Ab" & L).ClearContents
.Range("A2:Ab" & L).FormatConditions.Delete


Range("w2").Select
End With

'-----------------------------------------------------------------------------------
'--------------------------------------------Copie des données de la Feuille IMPORT
'je recopie depuis la feuille "IMPORT" les datas que je veux importer et transformer dans la feuille "CONVERSION"

---------'Dans l'exemple qui me concerne il ya 3000 lignes--------------

With Sheets("IMPORT")
'Copie de la DATE
    .Range("A2", .Range("A65536").End(xlUp).MergeArea).Copy
    Sheets("CONVERSION").Range("B2").PasteSpecial xlPasteValues
    
'Copie du LIBELLE
    .Range("c2", .Range("c65536").End(xlUp).MergeArea).Copy
    Sheets("CONVERSION").Range("w2").PasteSpecial xlPasteValues
    
'Copie du DEBIT
    .Range("D2", .Range("D65536").End(xlUp).MergeArea).Copy
    Sheets("CONVERSION").Range("P2").PasteSpecial xlPasteValues
    
  'Copie du  CREDIT
    .Range("E2", .Range("e65536").End(xlUp).MergeArea).Copy
    Sheets("CONVERSION").Range("Q2").PasteSpecial xlPasteValues
    
    
    
End With





'--------------------------------------------------------------------------------------------------
'------------------------------------------------Recherche de COMMERCE ET DIFFERENTES VALIDATIONS

'J'installe les formules prioritaires, notamment celle en Colonne X
'C'est long 3000 lignes avec une formule matricelle

With Sheets("CONVERSION")
Worksheets("CONVERSION").EnableCalculation = True


'COMMERCES
   .Range("x2").FormulaArray = _
    "=IF(ISNA(VLOOKUP(RC[-1],DATABUDGET,2,FALSE)),INDEX(DATABUDGET[LIBELLE],MAX(IF(ISNUMBER(SEARCH(DATABUDGET[ORIGINE],RC[-1])),ROW(DATABUDGET[LIBELLE])-1,0)),),VLOOKUP(RC[-1],DATABUDGET,2,FALSE))"

   .Range("x2").AutoFill Destination:=.Range("x2:x" & L), Type:=xlFillDefault
  
    'Validation Finale
    .Range("aa2:aa" & L).FormulaR1C1 = _
        "=IF(XLOOKUP(RC[-3],DATA!C[-25],DATA!C[-17],FALSE)<>""OUI"",""NON"",""OUI"")"
  
  
    'Contre validation des données
 .Range("z2:z" & L).FormulaR1C1 = "=VLOOKUP(RC[-2],DATABUDGET[[LIBELLE]:[Validation]],8,false)"
 


 

End With



'-----------------------------------------------------------------------
'------------------------------------------------Intallation des FORMULES

With Sheets("CONVERSION")
Worksheets("CONVERSION").EnableCalculation = False
'Code
  .Range("A2").Value = X + 1
  .Range("a3:a" & L).FormulaR1C1 = "=R[-1]C+1"
  '.Range("a2:a" & L).Value = .Range("a2:a" & L).Value


'Transformation de la DATE en ANNEE
  .Range("b2:b" & L).NumberFormat = "DD/MM/YYYY"
  .Range("C2:C" & L).FormulaR1C1 = "=YEAR(RC[-1])"
  '.Range("C2:C" & L).Value = .Range("C2:C" & L).Value
 
 
 
     'MOIS
 .Range("d2:d" & L).FormulaR1C1 = "=sansaccent(UPPER(TEXT((RC[-2]),""MMMM"")))"
 '.Range("d2:d" & L).Value = .Range("C2:C" & L).Value
  
 
   'BUDGETREEL = REEL
  .Range("E2:E" & L).Value = "REEL"
 
 
 'Compte
  .Range("F2:F" & L).Value = UCase(NomCompte)
 
 
  'N° de CHQ
  .Range("j2:j" & L).FormulaR1C1 = "=IF(RC[2]=""CHQ"",RIGHT(RC[13],7),"""")"
 
     'MODE = VRT
  .Range("l2:l" & L).FormulaR1C1 = "=XLOOKUP(RC[12],DATA!C[-10],DATA!C[-5],false)"
 
    
    'Tiers
  .Range("M2:M" & L).FormulaR1C1 = "=XLOOKUP(RC[11],DATA!C[-11],DATA!C[-5],FALSE)"
 
  
    'Futur = NON
  .Range("n2:n" & L).Value = "NON"
 
  'BQ =OUI
  .Range("o2:o" & L).Value = "OUI"
 
 
   'Débit Crédit
 .Range("R2:R" & L).FormulaR1C1 = "=RC[-1]-RC[-2]"
 

'Calcul du FLAG
.Range("s2:s" & L).Value = "OUI - " & Format(Date, "YYYY-MM-DD")

'Calcul du numéro de semaine
.Range("T2:T" & L).FormulaR1C1 = "=Year(RC2) & TEXT(NoSem(rc2),""00"")"
 
'Groupe
 .Range("H2:H" & L).FormulaR1C1 = "=VLOOKUP(RC[16],DATABUDGET[[LIBELLE]:[GROUPE]],4,FALSE)"
 
'Ligne
.Range("i2:i" & L).FormulaR1C1 = "=VLOOKUP(RC[15],DATABUDGET[[LIBELLE]:[LIGNE]],5,FALSE)"
 
 'Poste
  .Range("G2:G" & L).FormulaR1C1 = "=RC[1]&"" - ""&RC[2]"
 
'Libelle
  .Range("k2:k" & L).FormulaR1C1 = "=RC[-2]&"" l ""&TEXT(MONTH(RC[-9]),""00"")&""/""&YEAR(RC[-9])"


'Vérif Ligne
.Range("U2:U" & L).FormulaR1C1 = _
        "=IF((RC[-13]&"" - ""&RC[-12])=RC[-14],""OK"",""A VERIFIER"")"
      
        
 'Vérif Poste
.Range("V2:V" & L).FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC7,PARAMETRES!R1C3:R255C3,1,FALSE)),""Not Exist"",""Exist"")"
 
 
 
 

Worksheets("CONVERSION").EnableCalculation = True


End With

'-----------------------------------------------------------------------
'-----------------------------------------------VEROUILLAGE DES CELLULES

'Je figes les cellules

With Sheets("CONVERSION")
Worksheets("CONVERSION").EnableCalculation = False

'Commerces
 .Range("x2:x" & L).Value = .Range("x2:x" & L).Value

 'Code
  .Range("a2:a" & L).Value = .Range("a2:a" & L).Value
 
'Transformation de la DATE en ANNEE
  .Range("C2:C" & L).Value = .Range("C2:C" & L).Value

'MOIS
 .Range("d2:d" & L).Value = .Range("C2:C" & L).Value

 'N° de CHQ
.Range("j2:j" & L).Value = .Range("j2:j" & L).Value


 'MODE = VRT
  .Range("l2:l" & L).Value = .Range("l2:l" & L).Value
 
    
    'Tiers
  .Range("M2:M" & L).Value = .Range("M2:M" & L).Value
 
  
 
   'Débit Crédit
  '.Range("r2:r" & L).Value = .Range("r2:C" & L).Value
  
  'Calcul du FLAG
.Range("s2:s" & L).Value = .Range("s2:s" & L).Value

'Calcul du numéro de semaine
.Range("T2:T" & L).Value = .Range("T2:T" & L).Value
  
  
 'Groupe
  .Range("h2:h" & L).Value = .Range("h2:h" & L).Value
  
  
'Ligne
.Range("i2:i" & L).Value = .Range("i2:i" & L).Value
  
'Poste
  '.Range("G2:G" & L).FormulaR1C1 = "=RC[1]&"" - ""&RC[2]"

'Poste
  .Range("G2:G" & L).Value = .Range("G2:G" & L).Value
  
'Libelle
  .Range("k2:k" & L).Value = .Range("k2:k" & L).Value


'Vérif Ligne
.Range("U2:U" & L).Value = .Range("k2:k" & L).Value
        
 'Vérif Poste
.Range("V2:V" & L).Value = .Range("V2:V" & L).Value
  
  

'Contre validation des donneées
 .Range("z2:z" & L).Value = .Range("z2:z" & L).Value
 
'Validation Finale
.Range("aa2:aa" & L).Value = .Range("z2:z" & L).Value





Worksheets("CONVERSION").EnableCalculation = True
End With
'-------------------------------------------------------------------------
'------------------------------------------------Mise en place des formats

' Un peu de mise en page

With Sheets("CONVERSION")
'Couleur de fonds colonne X


.Range("A2:ab" & L).Interior.Color = vbWhite
 With .Range("A1").CurrentRegion
        .Borders(1).LineStyle = 0 'bordure gauche et insidevertical
        .Borders(2).LineStyle = 0 'bordure droite et insidevertical
        .Borders(3).LineStyle = 0 'bordure  top et 'insidehorizontal
        .Borders(4).LineStyle = 0 'bordure bottom et insidehorizontal
End With

 With .Range("A1").CurrentRegion
        .Borders(1).LineStyle = 3 'bordure gauche et insidevertical
        .Borders(2).LineStyle = 3 'bordure droite et insidevertical
        .Borders(3).LineStyle = 3 'bordure  top et 'insidehorizontal
        .Borders(4).LineStyle = 3 'bordure bottom et insidehorizontal
End With


'mfc

With .Range("A2:aa" & L).FormatConditions.Add(xlExpression, , "=ET($AA2=""OUI"";$Z2=""OUI"")")
    .Interior.Color = RGB(0, 255, 255)
    With .Font
        .Bold = False
        .Color = RGB(0, 0, 0)
    End With
End With



End With

Application.Calculation = xlCalculationAutomatic

Range("w2").Select
  
        
Application.ScreenUpdating = True
End Sub
 
Trier par date Trier par votes

Discussions similaires

L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
63
Latias
L
pompaero
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
192
pompaero
pompaero
R
  • Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
364
Dranreb
Dranreb
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
302
Usine à gaz
Usine à gaz
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
886
thivame
T
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
342
M@xu3L
M
R
  • Résolu(e)
XL 2016 extraire des données
Réponses
2
Affichages
493
rebatte
R
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
163
Francky79
F
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
226
florian50470
F
F
  • Résolu(e)
Microsoft 365 Commentaire cellule dans TextBox dans UserForm
Réponses
4
Affichages
371
Francky79
F

Membres actuellement en ligne

20 membres et 307 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 097
Messages
2 085 257
Membres
102 844
dernier inscrit
atori2