Macro boucle

[lombre2]

Voila j’aimerai réaliser une macro.
Je sais en réaliser des basiques voir des légèrement complexes. Mais ici, je bute dans tout les sens, sur un point la boucle.

En effet je voudrais réaliser une macro qui modifie la disposition des résultats qui m’intéressent et me les mettent sous forme de lignes.



Et donc je voudrais réaliser une macro qui détecte si en A2 c’est une 0 alors tu prends les valeurs de casse B2.D2.C3.B5.C7.D9. Et tu les colles en ligne sur la Feuil2. Si par contre c’est un 1 en A2 et A5 different de 1, alors tu prends les autres casses mentionnées en bleu. Et ceci pour les 2 autres types de tableau.

A chaque que fois que les valeurs sont copiées, la macro peut efface les lignes correspondantes, comme cela elle recommence tjs en A2. Je pense que cela serait plus facile.



Est-ce que quelqu’un pourrait m’aider ?
Je sais ou du moins je pense perso que cela n’est pas facile, mais si quelqu’un pouvait m’aider cela me ferait plaisir.

 

[jp14]

Re : Macro boucle

Bonjour

Ci dessous une première approche en relation avec le texte. Il faut modifier la procédure pour tenir compte du nombre de ligne qui peut être déterminé par "xxxxxxxxx" (en attente de confirmation).
Si tel est le cas en reprenant la même idée on détermine le nombre de ligne et en utilisant "select case" au lieu de "if then else" on sélectionne les lignes de code à exécuter.
Concernant les cellules à recopier il suffit de modifier
Data1= array("A...😉

Sub travdemande()

Dim i As Long
Dim j As Long

Dim nomfeuille1 As String
Dim col1 As String
Dim lidep1 As Long
Dim dl1 As Long

Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String
Dim dl2 As Long
Dim data1 As Variant



'**********************************
nomfeuille1 = "Feuil1"
col1 = "a"
lidep1 = 2


nomfeuille2 = "Feuil2"
col2 = "a"
lidep2 = 2
dl2 = Sheets(nomfeuille2).Range(col2 & "65536").End(xlUp).Row + 1
'************************************
With Sheets(nomfeuille1)

data1 = Array("")
If LBound(data1) = 0 Then j = 1

Do
dl1 = .Range("b65536").End(xlUp).Row + 2
If dl1 < 2 Then Exit Do

' select case 

If .Range("a2").Value = "0" Then ' case
        dl2 = Sheets(nomfeuille2).Range(col2 & "65536").End(xlUp).Row + 1
        data1 = Array("B2", "D2", "C3", "B5", "C7", "D9")
        
        For i = LBound(data1) To UBound(data1)
            Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value
        Next i
        For i = 13 To 1 Step -1
            .Rows(i).Delete Shift:=xlUp
        Next i
 '        
Else ' case 
        dl2 = Sheets(nomfeuille2).Range(col2 & "65536").End(xlUp).Row + 1
        data1 = Array("B2", "D2", "B3", "C4", "B6", "C10", "D10")
        
        For i = LBound(data1) To UBound(data1)
            Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value
        Next i
        For i = 17 To 1 Step -1
            .Rows(i).Delete Shift:=xlUp
        Next i

End If 'end select

Loop
End With

End Sub

A tester

JP

 

[jp14]

Re : Macro boucle

Bonjour

Ci joint le fichier avec la procédure à terminer pour recopier les données.
J'utilise le principe suivant pour reconaitre le nombre de ligne

val1 = Val(.Range("a2").Value)
val2 = Val(.Range("a5").Value) + Val(.Range("a6").Value)
val3 = Val(.Range("a9").Value)
Val1+val2+val3 = 0 pour 13 lignes
=1 pour 27 lignes
= 2 pour 17 lignes
= 3 pour 21 lignes
Il reste à écrire le contenu des variables data1 pour indiquer les cellules à copier en fonction du nombre de lignes.
data1 = Array("B2", "D2", "C3", "B5", "C7", "D9")

A tester

JP

 

[lombre2]

Re : Macro boucle

C’est génial, c’est magnifique. Cela marche. Cela va vraiment m’aider. Par contre j’avais une question les cellules que je sélection par exemple « d4 » et « b5 » je voudrais les mettre sur une même ligne mais dans des colonnes bien précises est ce possible. Si oui comment faire ?
Et j’avais vraiment une seconde question, pourriez-vous mettre la traduction des codes à cote car la première partie je ne la comprends pas vraiment (celle-ci après). Je pense comprendre mais par sur je suis assez novice. Les macros que je fais son manuel, et donc je n’y suis jamais arrivé à faire une boucle. Et je n’ai jamais trouvez une bonne explication ou livre traitant des boucles de manière complète.
Pouvez-vous me dire comment vous avez fait pour apprendre les macros ? En tout je vous remercie de tout cœur. Je vous dois une fière chandelle.



Il reste à écrire le contenu des variables data1 pour indiquer les cellules à copier en fonction du nombre de lignes.
data1 = Array("B2", "D2", "C3", "B5", "C7", "D9")

A tester

JP[/QUOTE]

 

[jp14]

Re : Macro boucle

Bonsoir

Concernat cette question il faudrait préciser les colonnes à utiliser car il faut gérer deux élément :
la valeur d4 et b5
et éviter d'écraser la valeur des cellules par une boucle

Par contre j’avais une question les cellules que je sélection par exemple « d4 » et « b5 » je voudrais les mettre sur une même ligne mais dans des colonnes bien précises est ce possible. Si oui comment faire ?

On pourra écrire par exemple en remplacement de la ligne

Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value

Select case i+j

  case 5,8 ' colonnes pour écrire les valeurs des cellules d4 et b5 par exemple

  case else
            Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value
end select
Sheets(nomfeuille2).Cells(dl2, 5).Value = .Range("D4").Value
Sheets(nomfeuille2).Cells(dl2, 8).Value = .Range("B5").Value

With Sheets(nomfeuille1) avec la feuille

data1 = Array("")
If LBound(data1) = 0 Then j = 1 ' si le premier indice d'un tableau est 0 alors pos = 1.
Le code option base permet de modifier le premier indice d'un tableau.

Do début de boucle
dl1 = .Range("b65536").End(xlUp).Row + 2 'dernière ligne écrite de la colonne B dans le tableau la colonne B contient des valeurs ce qui n'est pas le cas de la colonne A

If dl1 < 4 Then Exit Do' si la dernière écrite est inférieur à 4 par précaution j'ai pris cette valeur
on sort de la boucle

For i = LBound(data1) To UBound(data1) 'pour tout les adresses des cellules
Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value
'on range dans la feuille 2 le contenu de la cellule d'adresse en position i
' si on commence à 0 j =1 ce qui correspond à la colonne 1
Next i

For i = 13 To 1 Step -1 'on supprime les lignes quand on fait des suppressions il faut toujours partir de la dernière ligne sinon problème
.Rows(i).Delete Shift:=xlUp
Next i

JP

 

[lombre2]

Re : Macro boucle

Et bien merci beaucoup à vous.
Cela marche super, et j'ai appliqué le dernier code que vous m'avez envoyé. et je commence a comprendre le système.
Mais pourriez-vous me dire ou je dois changer pour que la copie sur la seconde page commence à la 4 eme ligne.
Et je sais je suis un peu fatiguant mais pourriez vous traduire en français les termes suivant pourquoi string, lidep1, dim. Car je voudrais bien comprendre les bases de la boucle en Visual basic.

Mais en tout cas cela marche a merveille.
Faite moi signe quand vous passez en Belgique je vous dois un pot.




Concernat cette question il faudrait préciser les colonnes à utiliser car il faut gérer deux élément :
la valeur d4 et b5
et éviter d'écraser la valeur des cellules par une boucle

On pourra écrire par exemple en remplacement de la ligne

Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value

Select case i+j

  case 5,8 ' colonnes pour écrire les valeurs des cellules d4 et b5 par exemple

  case else
            Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value
end select
Sheets(nomfeuille2).Cells(dl2, 5).Value = .Range("D4").Value
Sheets(nomfeuille2).Cells(dl2, 8).Value = .Range("B5").Value

With Sheets(nomfeuille1) avec la feuille

data1 = Array("")
If LBound(data1) = 0 Then j = 1 ' si le premier indice d'un tableau est 0 alors pos = 1.
Le code option base permet de modifier le premier indice d'un tableau.

Do début de boucle
dl1 = .Range("b65536").End(xlUp).Row + 2 'dernière ligne écrite de la colonne B dans le tableau la colonne B contient des valeurs ce qui n'est pas le cas de la colonne A

If dl1 < 4 Then Exit Do' si la dernière écrite est inférieur à 4 par précaution j'ai pris cette valeur
on sort de la boucle

For i = LBound(data1) To UBound(data1) 'pour tout les adresses des cellules
Sheets(nomfeuille2).Cells(dl2, i + j).Value = .Range(data1(i)).Value
'on range dans la feuille 2 le contenu de la cellule d'adresse en position i
' si on commence à 0 j =1 ce qui correspond à la colonne 1
Next i

For i = 13 To 1 Step -1 'on supprime les lignes quand on fait des suppressions il faut toujours partir de la dernière ligne sinon problème
.Rows(i).Delete Shift:=xlUp
Next i

JP[/QUOTE]