Discussion :

[atk_49]

Bonjour à tous.

Ci-dessous une boucle permettant à 300 cellules d'avoir les mêmes valeurs que 300 autres présentes sur un autre classeur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub CommandButton1_Click()
For j = 1 To 20
	For i = 1 To 15
		If Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(1, i+1) <> Workbooks("Classeur2.xlsx").Sheets("Feuil1").Cells(j+1, 1) Then
			Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(1, i+1) = Workbooks("Classeur2.xlsx").Sheets("Feuil1").Cells(j+1, 1)
		Else
		Exit For
		End If
	Next
Next
End Sub

Afin de gagner en temps d’exécution, je cherche à éviter la copie des cellules lorsque leurs valeurs sont similaires puis de passer à la suivante et ainsi de suite jusqu'à la fin de la boucle...
Or, ma fonction IF + Exit For stoppe totalement la boucle, comment puis-je faire ?

Merci d'avance et bonne journée à vous.

[Philippe PONS]

Salut,

en passant par des copies de tableaux vba c'est plus rapide!
NB: j'ai pas testé, c'est juste l'idée!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton1_Click()
Dim wkb1 As Workbook, wkb2 As Workbook
Dim shFrom As Worksheet, shTo As Worksheet
Dim varTab As Variant
 
Set wkb1 = Workbooks("Classeur1.xlsx")
Set wkb2 = Workbooks("Classeur2.xlsx")
Set shFrom = wkb1.Sheets("Feuil1")
Set shTo = wkb2.Sheets("Feuil1")
 
varTab = shFrom.Range(shFrom.Cells(1, 1), shFrom.Cells(15, 20))
 
shTo.Range("A1").Resize(UBound(varTab, 1), UBound(varTab, 2)) = varTab
'For j = 1 To 20
'    For i = 1 To 15
'        If Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(1, i + 1) <> Workbooks("Classeur2.xlsx").Sheets("Feuil1").Cells(j + 1, 1) Then
'            Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(1, i + 1) = Workbooks("Classeur2.xlsx").Sheets("Feuil1").Cells(j + 1, 1)
'        Else
'        Exit For
'        End If
'    Next
'Next
End Sub

[joe.levrai]

Bonjour,

ton Else et le Exit For ne sert à rien.
comme ça, si les cellules ont la même valeur, alors ton bloc If ne se vérifie pas ==> on passe directement à End If sans rentrer dans la copie de valeurs

cela dit, au vu de ton code, tu cherches à faire un copier/transposer de 20 cellules située sur une même colonne, vers 20 lignes (en mettant chaque ligne de départ sur une colonne) ? Tes "300 Cellules" correspondant donc à 20 cellules qu'on doit copier 15 fois (une fois par ligne ?)

si c'est bien ça, pas besoin de le faire cellule par cellule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub CommandButton1_Click()
Dim Tableau()
    Tableau = Application.Transpose(Workbooks("Classeur2.xlsx").Sheets("Feuil1").Cells(2, 1).Resize(20, 1).Value)
    Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(1, 2).Resize(20, 15).Value = Tableau
End Sub

si j'ai mal compris, expliques mieux la structure de départ (à copier) et la structure d'arrivée (là où on met les valeurs)
on pourra probablement le faire de la même façon que ma proposition : sans aucune boucle (et en s'aidant d'un tableau VBA si besoin)


EDIT : oups, salut Philippe PONS

Décidemment, on se marche beaucoup dessus en ce moment Mais ça renforce nos propositions puisqu'elles sont souvent identiques

[Philippe PONS]

Salut joe.levrai,

Pas de problème, j'aime bien lire tes posts, ça donne des idées!!

[atk_49]

Bonjour et merci pour vos propositions.

Vous avez tous les deux raison, je cherche en effet à copier les données d'un tableau à l'autre, mais, afin de simplifier ma demande, j'ai volontairement simplifier le code à boucler.
Le code original ne me permet pas de faire un simple copier/coller, principalement pour des raisons de correspondance (j'utilise le principe index + equiv), et aussi car certaines cellules de destination sont verrouillées.

Voici tout de même le code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
For j = 1 To 20
	For i = 1 To 15
				Workbooks("Classeur2.xlsx").Sheets("Feuil1").Range(Application.Index(Workbooks("Classeur2.xlsx").Sheets("Feuil1").Range("A4:AS56"), Application.Match(Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(1, i+1), Workbooks("Classeur2.xlsx").Sheets("Feuil1").Range("A5:A56"), 0)+1, Application.Match(Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(j+1, 1), Workbooks("Classeur2.xlsx").Sheets("Feuil1").Range("A4:AS4"), 0)).Address).Value = Application.Index(Workbooks("Classeur1.xlsx").Sheets("Feuil1").Range("A1:P30"), Application.Match(Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(j+1, 1), Workbooks("Classeur1.xlsx").Sheets("Feuil1").Range("A1:A30"), 0), Application.Match(Workbooks("Classeur1.xlsx").Sheets("Feuil1").Cells(1, i+1), Workbooks("Classeur1.xlsx").Sheets("Feuil1").Range("A1:P1"), 0))
	Next
Next
End Sub

Il fonctionne mais est long à exécuter (env 5 min), d'ou l'intérêt de vouloir éviter les cellules égales.


@joe.levrai, un exemple simplifié des classeurs est en PJ.

Edit : En testant mon code sur les deux classeurs mis en pièce jointe je m'aperçois que l’exécution est presque instantané, je pense donc désactiver le recalcul sur le fichier original et poursuivre mes tests....

[atk_49]

Problème résolu, la lenteur d’exécution venait du fait que le classeur de destination contenait trop de formule et que le système recalculait tout à chaque copie de cellule.
J'ai utilisé Application.Calculation = xlCalculationManual pour en venir à bout !

Merci à tous et bon week-end.