Problème avec boucle For VBA Excel
Bonjour à toutes et tous,
Je préfères d'avance annoncer que je suis novice en langage VBA §
La macro qui me pose problème est donc essentiellement construite à base de recherche sur des forums VBA, j'espère ne m'être pas trop planté sur les choix de code !
Feuil1 = base de données
Feuil2 = base de "recherche", la zone d'encodage étant A3:A4
Feuil3 = ne sert pas dans cet exemple (mais je souhaite quand même le conserver :)
Feuil4 = feuille de destination / résultat
L'idée c'est que j'ai besoin de certaines données issues de la Feuil1 pour faire un inventaire journalier :
- Feuil2 : je tape les 2 n° à 4 chiffres (3400 et 9435 pour l'exemple) pour lesquels je souhaite faire l'inventaire
- Je lance la macro :
Elle parcourt la colonne L de l'onglet Feuil1 à la recherche de mes 2 n°
Si trouvés, elle copie un certain nombre de données de la ligne sur laquelle à été trouvée chaque n° sur la ligne 11( Feuil2 ) pour le n° en case A3 et ligne 12 pour celui en A4.
Les infos copiées en ligne 11 et 12 de Feuil2 sont ensuite copiées dans l'ordre souhaité dans Feuil4 (lignes 3 et 4).
Pour info : tous les n° recherchés sont obligatoirement présents dans Feuil1 !
PROBLEME :
Lorsque je recherche 3400 (en A3 Feuil2) puis 9435 (en A4 Feuil2) -> tout fonctionne parfaitement
Mais Lorsque je recherche 9435 (en A3 Feuil2) puis 3400 (en A4 Feuil2) -> la macro s'arrête après avoir trouvé le N° 3400 (as tare2)
Pour info : je ne peux pas trier les données en colonne L Feuil1 ni encoder ma recherche dans n'importe quel ordre (j'ai d'autres contraintes cachées derrière que je ne mentionne pas ici)
Me suis-je planté dans ma définition ou dans les emplacement Exit For ou autres ?
D'avance merci pour le temps consacré à ma demande !
PS : le fichier (version épurée) est en PJ, et voici également le code ci dessous,
Bonne journée
Tom
Sub Edition_Inventaire()
' Définition des variables
Sheets("Feuil2").Select
Dim tare1 As String
tare1 = Range("A3").Value
Dim tare2 As String
tare2 = Range("A4").Value
Sheets("Feuil4").Activate
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
'Boucle de recherche + copie données
Col = "L" ' colonne de la donnée non vide à tester
NumLig = 1
With Sheets("Feuil1") ' feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 5 To NbrLig
If .Cells(Lig, Col).Value = tare1 Then
.Range("K" & Lig & ",L" & Lig & ",A" & Lig & ",C" & Lig & ",AY" & Lig & ",Q" & Lig & ",V" & Lig & ",W" & Lig).Copy
Sheets("Feuil2").Select
Range("A11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .Cells(Lig, Col).Value = tare2 Then
.Range("K" & Lig & ",L" & Lig & ",A" & Lig & ",C" & Lig & ",AY" & Lig & ",Q" & Lig & ",V" & Lig & ",W" & Lig).Copy
Sheets("Feuil2").Select
Range("A12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Feuil4").Range("A3") = Sheets("Feuil2").Range("C11")
Sheets("Feuil4").Range("A4") = Sheets("Feuil2").Range("C12")
Sheets("Feuil4").Range("B3") = Sheets("Feuil2").Range("D11")
Sheets("Feuil4").Range("B4") = Sheets("Feuil2").Range("D12")
Sheets("Feuil4").Range("C3") = Sheets("Feuil2").Range("E11")
Sheets("Feuil4").Range("C4") = Sheets("Feuil2").Range("E12")
Sheets("Feuil4").Range("D3") = Sheets("Feuil2").Range("F11")
Sheets("Feuil4").Range("D4") = Sheets("Feuil2").Range("F12")
Sheets("Feuil4").Range("E3") = Sheets("Feuil2").Range("H11")
Sheets("Feuil4").Range("E4") = Sheets("Feuil2").Range("H12")
Sheets("Feuil4").Range("F3") = Sheets("Feuil2").Range("A11")
Sheets("Feuil4").Range("F4") = Sheets("Feuil2").Range("A12")
Sheets("Feuil4").Range("G3") = Sheets("Feuil2").Range("B11")
Sheets("Feuil4").Range("G4") = Sheets("Feuil2").Range("B12")
Exit For
End If
End If
Next
End With
End Sub
Salut TomSwice,
solution en premier jet à l'arrache sans protection ni recherche de performance.
Question : combien de lignes y a-t-il dans la base de données?
Un double-clic sur la 'Feuille2' déclenche la macro.
With sWk1
For x = 6 To .Range("L" & Rows.Count).End(xlUp).Row
If .Range("L" & x).Value = sWk2.[A3] Or .Range("L" & x).Value = sWk2.[A4] Then _
iFlag = iFlag + 1: _
iRow = IIf(.Range("L" & x).Value = sWk2.[A3], 21, 22): _
sWk2.Range("A" & iRow).Resize(1, 8).Value = Array(.Range("K" & x).Value, .Range("L" & x).Value, .Range("A" & x).Value, _
.Range("C" & x).Value, .Range("AY" & x).Value, .Range("Q" & x).Value, .Range("V" & x).Value, .Range("W" & x).Value): _
sWk4.Range("A" & iRow - 8).Resize(1, 7).Value = Array(sWk2.Range("C" & iRow).Value, sWk2.Range("D" & iRow).Value, _
sWk2.Range("E" & iRow).Value, sWk2.Range("F" & iRow).Value, sWk2.Range("H" & iRow).Value, _
sWk2.Range("A" & iRow).Value, sWk2.Range("B" & iRow).Value): _
If iFlag = 2 Then Exit For
Next
End WithLes résultats, différents de ce que tu montres, correspondent pourtant aux données de ton code...
Ils s'affichent sur d'autres lignes que celles demandées. Tu pourras mieux voir ce qui cloche et réparer.
.Range("K" & Lig & ",L" & Lig & ",A" & Lig & ",C" & Lig & ",AY" & Lig & ",Q" & Lig & ",V" & Lig & ",W" & Lig).CopyA+
Cela dit, si ta recherche ne porte systématiquement que sur 2 nombres pour 2 lignes de résultats, des formules feront bien mieux l'affaire
=INDEX(Feuil1!A6:AY11;EQUIV(A4;Feuil1!L6:L11);1)A+
Salut curulis57,
Merci pour la réponse je teste ça de ce pas,
Question : combien de lignes y a-t-il dans la base de données?
Il y a entre 400 et 800 lignes dans la base de données !
A+
TomSwice