VBA : Optimisation + Modification d'une formule

Bonjour!

Je suis un étudiant en plein stage et j'aurais besoin d'aide!

Il y a 2 questions que j'aimerais poser :
- Premièrement, j'ai un classeur excel composé d'environ 35000 lignes, et je dois faire une comparaison entre deux colonnes A et B (comparer 2 références)
puis inscrire "O" ou "N" dans une autre colonne C, si la référence en A et la meme qu'en B. Pour se faire, je fais ceci :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Dim finColDistrib As Long, finColOT As Long, i As Long Dim res As Variant, search As Variant Dim rng As Range   Worksheets("Feuil1").Activate   finColOT = Cells(Rows.Count, "B").End(xlUp).Row finColDistrib = Cells(Rows.Count, "A").End(xlUp).Row Set rng = Range("B3:B" & finColOT)   For i = 3 To finColDistrib search = Range("A" & i) Set res = rng.Cells.Find(What:=search, LookAt:=xlWhole) If (res Is Nothing) Then Range("C" & i) = "N" ElseIf (res = search) Then Range("C" & i) = "O" End If Next i

---

Le problème est que le temps d'exécution est vraiment trop long ... Est-il possible d'optimiser un peu svp? :calim2:

- Deuxièmement, je copie une colonne avec une formule d'un classeur Class1 dans un autre classeur Class2, j'aimerais copier seulement la formule dans le Class2. Ca j'ai réussi :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Dim classeurSrc As Excel.Workbook Set class1 = Workbooks.Open(cheminSrc & "Class1")   class1.Worksheets("Feuil1").Activate finCol = Cells(Rows.Count, "A").End(xlUp).Row Range("A2:A" & finCol).Copy DisplayAlerts = False class2.Worksheets("Feuil1").Range("A2").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False DisplayAlerts = True   class2.Save class1.Close

---

Le problème est que, dans la formule, on a besoin des données qui se trouvent dans une autre feuille du classeur, et que donc, quand je copie la formule dans Class2, la formule va chercher les données nécessaires dans la Feuil2 de Class1 qui est le classeur d'ou je viens de copier la colonne... Il faudrait que la formule aille chercher les données dans la Feuil2 de Class2. Du coup, comment dois-je faire?

Je vous remercie d'avance! :D
Cordialement!

Bonjour !

1) Les références sont-elles dans la même ligne? Si c'est le cas tu pourrais juste comparer le contenu de deux cellules à chaque boucle.
Sinon tu peux toujours en cadrer ton code par

Code:

---

1 2 3

Application.ScreenUpdating = False 'ton code Application.ScreenUpdating = True

---

Ca désactivera jusqu'à la fin de l’exécution du code l'affichage ce qui pourrait avoir un impact pour un affichage de 35 000 lignes.

2)
As-tu essayé la fonction indirect() dans ta formule?
En passant l'argument transpose à true?

Hey! :D

Huuum je vais essayer le coup de l'affichage désactivé, je te dis si ça améliore quelque chose ou non!
Les références ne sont pas sur la même ligne, en fait, la colonne A fait environ 200 lignes, tandis que la B en fait 35000. Je compare la référence de la colonne B avec toutes celles présentes en A. Si Find trouve la référence de la colonne B dans la colonne A, je mets "O" en C, sinon je mets "N"

Et je ne connais pas la formule indirect(), pourrais tu m'en dire plus s'il te plait? :)

En tout cas, merci de ta réponse si rapide!

Bonjour,

pour la comparaison de tes deux colonnes, tu peux utiliser une formule (éventuellement par VBA, tu trouveras sur le site des billets de blog qui en expliquent le fonctionnement)

voici un exemple "format Excel" où je n'ai pas optimisé la plage utile de la colonne B
Cette formule est placée en C1, et si je l'étire sur ma colonne C, elle fonctionne pour chaque ligne

Citation:

---

=SI(NB.SI($B:$B;A1)>0;"O";"N")

---

Astuce : si tu passes par une formule relative (.FormulaR1C1), tu auras la possibilité, sans aucune boucle, d'appliquer ta formule sur l'ensemble de ta plage.
Un conseil pour apprendre : enregistre une macro où tu écris cette formule en C1. Tu obtiendras la méthode R1C1 dont j'ai parlé. Il faudra adapter pour effectuer l'application sur toute ta colonne


pour la copie des formules ... ne serait-il pas plus pratique de les écrire directement dans ta feuille de destination, plutôt que de les copier pour ensuite en modifier les références ?
A quoi ressemble cette formule d'ailleurs ?
Par ailleurs, la propriété .Formula va te retourner la formule présente dans une cellule. Tu peux très bien "remplacer" la référence voulue avec une fonction Replace() puisque tu disposeras de la formule sous forme de chaine de caractère

Bonjour,
tu peux essayer avec avec la méthode CountIf
un exemple à adapter :

Code:

---

1 2 3 4 5 6 7 8 9 10

Sub ComparaisonOuiNon() Set DataSource = Feuil2.Range("I3:I8") DataCible = Feuil2.UsedRange.Columns(1) Columns(2).Resize(UBound(DataCible)) = "NON" For i = 1 To UBound(DataCible) If WorksheetFunction.CountIf(DataSource, DataCible(i, 1)) = 1 Then Range("B" & i).Value = "OUI" End If Next End Sub

---

Donc bien sur il faut faire le bon pointage et le bon ciblage ;)

Edit : Hi @joe.levrai :mouarf: on s'est croisé dans la réponse ;) :plusser:

Bonjour Joe.Levrai :D

J'aurais du commencer par ça oui! Voici la formule :

Code:

---

=RECHERCHEV(K195;'Feuil2'!$A$2:$B$16;2;FAUX)

---

Si j'ai décidé de copier la colonne avec la formule toute prête, c'est parce que, quand je créais la formule au fur et à mesure pour chaques cellules (il y a 35000 lignes je rappelle), l'exécution continuais toujours au bout de 30 minutes ... C'est beaucoup trop long ...
Il faut aussi que tout se fasse automatiquement (consigne donnée par mon tuteur), et donc je ne peux pas étendre la formule à la main.

Avec .FormulaR1C1, j'avais déja essayé, mais je n'avais pas compris le fonctionnement ...

Et comment marche replace()? Désolé pour le dérangement ^^'

Merci de ta réponse :)

voilà un moyen de copier ta formule sur toutes les lignes d'un coup (à adapter)
(Attention bien noter dans la formule la partie relatif ou absolue dans l'adresse)

Code:

---

1 2	Feuil1.Range("F3").FormulaLocal = "=$E3-$D3" 'Remplacer par ta formule Feuil1.Range("F3").Copy Destination:=Feuil1.Range("F3:F8")' pour la copier sur la plage voulue => à définir

---

Hey @RyuAutodidacte !

Je vais essayer ton exemple :D

D'ailleurs, @MacKay77 , je suis désolé, mais ScreenUpdating = False/True ne change pas grand chose :( Le temps d'exécution est toujours aussi long

Bonjour,

Si tu tiens à utiliser une macro je te suggère de faire en 2 tours avec un dictionnaire:

Code:

---

1 2 3 4

Set MonDico = CreateObject("Scripting.Dictionary") For i = 3 To finColOT If Not MonDico.Exists(CStr(Cells(i, 2).Value)) Then MonDico.Add CStr(Cells(i, 2).Value), "" Next i

---

Ensuite tu boucle pour vérifier :

Code:

---

1 2 3 4 5 6 7

For i = 3 To finColDistrib If MonDico.Exists(CStr(Cells(i, 1).Value)) Then Range("C" & i) = "O" Else Range("C" & i) = "N" End If Next i

---

Même sur 35k lignes cela devrait être rapide.

Je suis désoler je ne peux pas plus explicité maintenant je dois partir en entretien d'embauche.

Bon courage et hésite pas à te documenter sur le Web ya plein de bonnes explications du dico.

DeathZarakai.

Citation:

---

Envoyé par SuperBug

Hey! :D
Et je ne connais pas la formule indirect(), pourrais tu m'en dire plus s'il te plait? :)

En tout cas, merci de ta réponse si rapide!

---

Citation de l'aide d'office :

Citation:

---

Renvoie la référence spécifiée par une chaîne de caractères. Les références sont immédiatement évaluées afin d’afficher leur contenu. Utilisez la fonction INDIRECT lorsque vous voulez modifier la référence à une cellule à l’intérieur d’une formule sans modifier la formule à proprement parler.

---

Je ne l'ai jamais testé mais ça a l'air de faire ce que tu souhaitais

@Mackay77 , Merci du tuyau! Je vais regarder ca plus en profondeur :)

Tiens mets ce code dans un module dans un nouveau classeur tout va se faire automatiquement pour une petite démonstration
le tableau Toto insère les valeurs à checker en col I => pour toi ça sera en colonne B (quelque soit le nombre d'éléments à vérifier ça ne posera pas de pbm)
le sub copie n'est là que pour mettre en place les fausses données

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Sub Copie() Dim i As Long, Toto Application.ScreenUpdating = False For i = 1 To 35000 Cells(i, 1) = i Next Toto = Array(1, 5, 10, 35, 35000, 25, 75, 12, 150, 20000, 22000) Cells(1, 9).Resize(UBound(Toto)).Value = Application.Transpose(Toto) ComparaisonOuiNon Application.ScreenUpdating = True End Sub   Sub ComparaisonOuiNon() Set DataSource = Feuil1.Range("I1:I10") DataCible = Feuil1.UsedRange.Columns(1) Columns(2).Resize(UBound(DataCible)) = "NON" For i = 1 To UBound(DataCible) If WorksheetFunction.CountIf(DataSource, DataCible(i, 1)) = 1 Then Range("B" & i).Value = "OUI" End If Next End Sub

---

Pour toi dans ta colonne A tu auras tes données
Dans ta colonne B du même classeur les données récupérer du second classeur soit par une rechercheV ou autre
En Col C les réponses OUI/NON
Mais bien sur tout cela est à adpater ;)

Les boucles sont inutiles pour la formule de comparaison

un exemple, travaillant sur la feuille active, qui écrit en colonne C (en commençant par la ligne 1 et jusqu'à la première ligne vide en colonne A) la formule
j'ai mis une ligne en commentaire, elle remplace la formule par la valeur

si le classeur est lent, il faut neutraliser le recalcul de la feuille durant l'exécution de tes procédure (Application.Calculation)

Code:

---

1 2 3 4

With Cells(1, 3).Resize(Cells(1, 1).End(xlDown).Row, 1) .FormulaR1C1 = "=IF(COUNTIF(R1C2:R" & UsedRange.Rows.Count & "C2,RC[-2])>0,""O"",""N"")" '.Value = .Value 'remplace les formules par les valeurs si besoin End With

---

Pour ta seconde formule, une proposition, idem on écrit dans la colonne C tant qu'on atteri pas sur une cellule vide de la colonne A
j'ai utilisé la formule brute que tu as fourni, contrôle ce qu'il ressort dans ta feuille excel (je pense notamment au K195 qui s'appliquera en C1, puis K196 en C2 etc..) et ajuste en conséquence

Code:

---

1 2 3 4

With Cells(1, 3).Resize(Cells(1, 1).End(xlDown).Row, 1) .FormulaR1C1 = "=VLOOKUP(R[194]C[8],Feuil2!R2C1:R16C2,2,FALSE)" '.Value = .Value 'remplace les formules par les valeurs si besoin End With

---

joe.levrai :

- Pour ta premiere formule, une erreur apparait : erreur 424 --> Objet requis

Dans mon vrai classeur, il faut que je compare les colonnes 51 et 11, et que je mette les résultats (O/N) dans la colonne 48.
Du coup j'ai écris ca : .FormulaR1C1 = "=IF(COUNTIF(R3C11:R" & UsedRange.Rows.Count & "C11,R3C51)>0,""O"",""N"")"- Pour ta deuxième formule, il faudrait que le "R[194]C[8]" s'incrémente automatiquement, en partant de 2 jusqu'à la dernière ligne (35000 environ)

Désolé pour les autres réponses, je regarderai plus tard, j'ai finis ma journée et je dois rentrer! Merci a tout le monde en tout cas :D

pour la comparaison, tu as mal adapté.

déjà, attention car ma proposition était valable sur la feuille active, ce qui n'est peut être pas ton cas

je vais donc commenter la formule, afin que tu puisses corriger seul :

Code:

---

1 2 3 4 5 6 7 8 9 10 11

' La Feuille 'La Cellule C1 étendue sur le nombre de lignes où la cellule de A n'est pas vide, soit la plage C1:Cy où y est la dernière ligne non vide With Worksheets("NomDeLaFeuille").Cells(1, 3).Resize(Cells(1, 1).End(xlDown).Row, 1) 'RC[-2] = Même ligne que la formule et 2 colonnes à gauche = Ax où x est la ligne où la formule est écrite .FormulaR1C1 = "=IF(COUNTIF(R1C2:R" & UsedRange.Rows.Count & "C2,RC[-2])>0,""O"",""N"")" ' Si(NB.SI( 'R1C2 = Ligne 1 / Colonne 2 = $B$1 'R" & UsedRange.Rows.Count & "C2 = Ligne "Dernière ligne de la plage" / Colonne 2 = $B$DerniereLigne '==> $B$1:$B$Dernière ligne     End With

---

@joe.levrai
Merci je testerai aussi je n'ai jamais écris le code de cette manière ;)

Re bonjour!

Joe.Levrai
Du coup j'ai testé, la première formule marche bien mieux que la mienne d'avant! Merci!

Par contre, la deuxième est vraiment trop longue, au moins 5 minutes pour s'éxecuter ... C'est légérement long
Je ne sais pas si c'est le programme qui est trop gourmand ou bien si le problème vient de mon pc, mais y aurait-il moyen de réduire ce temps d'éxecution?

Merci d'avance!

Bonjour,

as-tu désactivé le recalcul du classeur lors du traitement ?
as-tu besoin de conserver le formules ou bien les valeurs seules suffisent ? J'avais mis une ligne à commentaire pour réaliser ça.

faut pas non plus s'attendre à des miracles lorsqu'on met 35 000 rechercheV sur une feuille .... sans parler des milliers d'autres formules que tu doit avoir sur ton classeur.
là je t'ai proposé ce qu'il me semble être le plus rapide pour manipuler/écrire une formule Excel (gourmande) sur 35 000 lignes. Y'a aucune boucle et aucun ralentisseur (select, activate etc...).
Le seul angle optimissable c'est de neutraliser le recalcul de la feuille et le rafraichissement d'écran.


si vraiment après avoir tout optimisé ça ne va pas mieux, il va falloir que tu passes par un tableau interne VBA ... mais qui du coup t'obligera à faire une boucle sur chaque ligne pour calculer la valeur à renvoyer. Le gain de temps risque d'en pâtir, et tu n'auras plus la possibilité de conserver la formule Excel dans la cellule.


merci de poster les 2 codes complets pour qu'on puisse voir ce que ça raconte. Sans oublier de répondre aussi précisément que possible aux questions que j'ai posé.

- Je n'ai pas pu désactiver le recalcul car ça me mettait une erreur, je dois surement mal l'utiliser :? le code ressemblait à :

Code:

---

1 2 3

Calculation = False .... Code .... Calculation = True

---

- Nop je n'ai pas besoin de conserver les formules, mais pour ca, j'ai juste à appliquer le code que tu as déjà mis.

Pour l'instant, mon code ressemble à :
- pour la comparaison :

Code:

---

1 2 3 4 5

With Worksheets("ExportDelais") For i = 3 To finColDist .Cells(i, 46).FormulaR1C1 = "=IF(COUNTIF(R3C51:R" & finColOt & "C51,R" & i & "C[-31])>0,""O"",""N"")" Next i End With

---

- pour copier la formule dans un autre classeur :

Code:

---

1 2 3 4

class1.Worksheets("ExportDelais").Activate finCol = Cells(Rows.Count, "A") .End(xlUp).Row Range("AT2:AT" & finCol).Copy class2.Worksheets("ExportDelais").Range("AT2").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

---

Et après l'avoir copié (ou avant je ne sais pas), il faudrait pouvoir remplacer une partie de la formule. J'ai essayé avec Replace(), mais sans succès, je tombe toujours sur des erreurs (2042, 3043 ect ...), je dois mal l'utiliser aussi. Auriez-vous une solution s'il vous plait?

Merci d'avance :D

bonjour,
si tu avais regardé l'aide vba tu aurais touvé :

Code:

---

Application.Calculation = xlCalculationManual

---

Code:

---

Application.Calculation = xlCalculationAutomatic

---