boucle for avec variable comme fin

[kiki31140]

Bonjour à tous
je reviens vers vous car je suis à nouveau coincé.
Je cherche une solution pour une boucle for avec comme parametre de fin , la valeur qui se trouve dans une cellule.

Je m'explique.
J'ai créé un fichier avec des macros.
Une des macros récupère un fichier xml et le mets en forme.
Ensuite je compte le nombre de variable dans une colonne et je place l'info dans une cellule "G1"
je lance ma boucle for avec comme parametre de fin , la valeur de G1.

voici une parti du code :


Sub ImportXml()

ActiveWorkbook.XmlImport URL:=Application.GetOpenFilename("Fichier XML (*.xml),*.xml", , "Choisir le fichier"), ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$4")
Dim nb As Integer
nb = Application.WorksheetFunction.CountA(ActiveSheet.Range("G5:G65536"))
Range("G1").Value = nb

End Sub
----------------------------------
Sub Macro1()
J = 1
For I = 1 To "G1"
Worksheets("init").Activate
Range("A4").Select
ActiveCell.Offset(J, 4).Activate
While ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Activate
J = J + 1
Wend

etc, etc, etc ......

Et là ça coince ....

merci par avance pour votre aide

Amicalement
christian

 

[Kersijus]

Re : boucle for avec variable comme fin

Bonjour,

Vous pouvez mettre la valeur de la cellule dans une variable, par exemple*:

k = Activesheet.Range("G1")
…
For I = 1 to k
…

Cordialement

 

[Robert]

Re : boucle for avec variable comme fin

Bonjour le fil, bonjour le forum,

remplace :

For I = 1 To "G1"

par :

For I = 1 To CInt(Range("G1").Value)

 

[kiki31140]

Re : boucle for avec variable comme fin

merci

ça marche

Bonne journée
A

 

[kiki31140]

Re : boucle for avec variable comme fin

Bonjour à tous
alors en fait, ça ne fonctionne pas tant que ça
J'ai appliqué la solution de Robert et en fait ma boucle tourne jusqu'a 65536, avec l'erreur 1004, sur la ligne :
ActiveCell.Offset(1, 0).Activate

voici mon code :

Sub Macro1()

'On compte le nombre de paramètre dans la colonne
Dim k As Integer
k = Application.WorksheetFunction.CountA(ActiveSheet.Range("F5:F5000"))
Range("G1").Value = k
MsgBox " le nombre est : " & k

J = 1

For I = 1 To CInt(Range("G1").Value)
Worksheets("init").Activate
Range("A4").Select
ActiveCell.Offset(J, 4).Activate
While ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Activate
J = J + 1
Wend
Selection.Copy
Worksheets("Feuil2").Activate
Range("A1").Select
ActiveCell.Offset(I, 0).Activate
ActiveSheet.Paste

etc, etc, etc ......

merci par avance
Christian

 

[Robert]

Re : boucle for avec variable comme fin

Bonjour Christian, bonjour le forum,

Il est normal que tu aies cette erreur à la ligne 65653 puisque c'est la dernière ligne (sous Excel 2003) et par conséquent Activecell.Ofsset(1, 0).Activate va générer cette erreur. J'essai de comprendre ton code mais j'ai du mal. Par exemple :

    For I = 1 To CInt(Range("G1").Value)
        Worksheets("init").Activate
        Range("A4").Select
        ActiveCell.Offset(J, 4).Activate

Au lieu de :

     For I = 1 To CInt(Range("G1").Value)
        Worksheets("init").Activate
        Range("E54").Activate

Ensuite tu cherches quoi avec :

While ActiveCell.Value = ""
            ActiveCell.Offset(1, 0).Activate
            J = J + 1
        Wend

Si tu veux la dernière ligne éditée de la colonne E :

Cells(Application.Rows.Count, 5).End(xlUp).Select

Essaie d'expliquer ce que tu voudrais que la macro fasse et on pourra te donner des solutions adéquates...

 

[kiki31140]

Re : boucle for avec variable comme fin

Bonjour Robert

Comme expliquer dans mon premier message, je récupère des données d'un fichier xml dans l'onglet init.
Ensuite, je place dans l'onglet feuil2 des valeurs du premier onglet.
je ne prends pas tout.
voici mon fichier
l'import xml a déja été fait.
pas besoin de le refaire
il n'y a que moulinette à activer.

pour info, le nombre de parametre en colonne E est variable suivant le xml chargé.
merci

 

[Robert]

Re : boucle for avec variable comme fin

Bonjour Christian, bonjour le forum,

Pas sûr d'avoir bien compris mais voilà comment je verrais les choses :

Sub Macro1()
Dim I As Object 'déclare la variable I (onglet Init)
Dim F As Object 'déclare la variable F (onglet Feuil2)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim Client As String 'déclare la variable client
Dim valeur As Variant 'déclare la variable valeur


Set I = Sheets("Init") 'définit l'onglet I
Set F = Sheets("Feuil2") 'définit l'onglet F
DL = I.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière Ligne éditée DL de la colonne 1 (=A) de l'onglet I
Set PL = I.Range("E5:E" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionanaire D
For Each cel In PL 'boucle sur toutes les cellules CEL de la plage PL
    If cel.Value <> "" Then D(cel.Value) = cel.Row 'si la cellule n'est pas vide, récupère le numéo de la cellule
Next cel 'prochaine cellule de la boucle
TMP = D.items 'récupère la liste des lignes éditées de la colonne 5, dans le tableau temporaie TMP
For J = 0 To UBound(TMP) 'boucle sur toutes les valeurs du tableau TMP
    'définit la cellule de destination DEST de l'onglet F (A1, si A1 est vide, sinon la première ligne vide de la colonne 1 (=A))
    Set DEST = IIf(F.Range("A1").Value = "", F.Range("A1"), F.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
    DEST.Value = I.Cells(TMP(J), 5) 'récupère le [prog] dans DEST
    If I.Cells(TMP(J), 6).End(xlDown).Offset(1, 0).Value <> "" Then
        Client = I.Cells(TMP(J), 6).End(xlDown).Value & "," & I.Cells(TMP(J), 6).End(xlDown).Offset(1, 0).Value
    Else
        Client = I.Cells(TMP(J), 6).End(xlDown).Value
    End If
    DEST.Offset(0, 1).Value = Client 'récupère le ou les [subsystems] dans DEST décalée d'une colonne à droite
    If InStr(I.Cells(TMP(J), 7).End(xlDown).Value, ":") = 0 Then
        valeur = I.Cells(TMP(J), 7).End(xlDown).Value
    Else
        valeur = "'" & I.Cells(TMP(J), 7).End(xlDown).Value
    End If
    DEST.Offset(0, 4).Value = valeur 'récupère la [refValue] dans DEST déclalée de quatre colonnes à droite
    DEST.Offset(0, 2) = Cells(TMP(J), 9).End(xlDown) 'récupère le [name] dans DEST déclalée de neuf colonnes à droite
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la lige suivante)
    If I.Cells(TMP(J), 10).End(xlDown).Row < TMP(J + 1) Then 'condition si la ligne de la première cellule non vide dans la colonne 10 (+J) est supérieure à la valeur de TMP(J+1)
        'récupère la [description] dans DEST déclalée de deux colonnes à droite
        DEST.Offset(0, 3).Value = I.Cells(TMP(J), 10).End(xlDown).Value
    End If 'fin de la condition (cete condition génère une erreur pour la dernière valeur du tableau TMP)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'annule l'erreur
        'récupère la [description] dans DEST déclalée de deux colonnes à droite
        DEST.Offset(0, 3).Value = I.Cells(TMP(J), 10).End(xlDown).Value
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
Next J 'prochaine valeur du tableau TMP
F.Sort.SortFields.Clear
F.Sort.SortFields.Add Key:=Range("A1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With F.Sort
    .SetRange F.Range("A1:O738")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
F.Select 'sélectionne l'onglet F
F.Range("A1").Select 'sélectionne A1 de l onglet F
End Sub

 

[kiki31140]

Re : boucle for avec variable comme fin

wouha ...
merci Robert.
Je l'essaie demain matin car je ne suis plus au travail.
je te réponds aussitôt que j'appliquerais mon xml.
bonne soirée et a demain.

 

[kiki31140]

Re : boucle for avec variable comme fin

Bonjour Robert
enfin je prends le clavier pour répondre.
J'ai essayé ta macro et malheureusement cela ne fonctionne pas comme je le souhaite.
en effet, le fichier XML que je récupère, comporte pas loin de 800 paramètres dans ma colonne E , avec des infos en cascade comme je l'ai mis dans mon fichier.
Avec ta macro, elle ne traite que les 4 premières lignes, alors qu'elle devrait traiter tous les paramètres jusqu'a 800, puis s'arrêter.

Même lorsque je relance cette même macro, elle traite toujours les mêmes infos et les mets à la suite des premières dans feuil2.

j'espere que j'ai réussi à me faire comprendre.

Je reste à ta dispo si besoin.

Pour info, je ne peux pas te donner mon fichier xml, mais par comtre , on peut créer un avec des données bidons.

Cdlt
Christian

 

[Robert]

Re : boucle for avec variable comme fin

Bonjour Kiki, bonjour le forum,

Oui il me faudrait un fichier avec des données bidons mais qui reflètent bien l'ensemble des cas de figures que tu as avec ton original.

 

[kiki31140]

Re : boucle for avec variable comme fin

re
voici mon fichier avec les 4000 et quelques lignes
et le résulat attendu en feuil 2

 

[Robert]

Re : boucle for avec variable comme fin

Bonjour le fil, bonjour le forum,

Ok, super exemple ! Je regarde ça quand j'ai un moment...

 

[Robert]

Re : boucle for avec variable comme fin

Bonsoir le fil, bonsoir le forum,

En pièce jointe ton dernier fichier modifié. J'ai lancé la macro ci-dessous et renvoyé les données dans l'onglet Feuil2 (2). Si on compare avec ton résultat onglet Feuil2, ça semble concorder...
Le code :

Public Sub Macro1()
Dim I As Object 'déclare la variable I (onglet Init)
Dim F As Object 'déclare la variable F (onglet Feuil2)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TL As Variant 'déclare la variable TL (Tableau des Lignes)
Dim X As Integer 'déclare la variable X (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim Client As String 'déclare la variable client
Dim valeur As Variant 'déclare la variable valeur

Set I = Sheets("Init") 'définit l'onglet I
Set F = Sheets("Feuil2 (2)") 'définit l'onglet F
DL = I.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière Ligne éditée DL de la colonne 1 (=A) de l'onglet I
Set PL = I.Range("E5:E" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    If CEL.Value <> "" Then 'condition : si la cellule CEL n'est pas vide
        ReDim Preserve TL(X) 'redimensionne le tableau de variable TL
        TL(X) = CEL.Row 'attribut le numéro de ligne de CEL à la variable indexée TL(X)
        X = X + 1 'incrémente X
    End If 'fin de la condition
Next CEL 'prochaine cellule de la boucle
For X = 0 To UBound(TL) 'boucle sur toutes les valeurs du tableau TL
    'définit la cellule de destination DEST de l'onglet F (A1, si A1 est vide, sinon la première ligne vide de la colonne 1 (=A))
    Set DEST = IIf(F.Range("A2").Value = "", F.Range("A2"), F.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
    DEST.Value = I.Cells(TL(X), 5) 'récupère le [prog] dans DEST
    If I.Cells(TL(X), 6).End(xlDown).Offset(1, 0).Value <> "" Then
        Client = I.Cells(TL(X), 6).End(xlDown).Value & "," & I.Cells(TL(X), 6).End(xlDown).Offset(1, 0).Value
    Else
        Client = I.Cells(TL(X), 6).End(xlDown).Value
    End If
    DEST.Offset(0, 1).Value = Client 'récupère le ou les [subsystems] dans DEST décalée d'une colonne à droite
    If InStr(I.Cells(TL(X), 7).End(xlDown).Value, ":") = 0 Then
        valeur = I.Cells(TL(X), 7).End(xlDown).Value
    Else
        valeur = "'" & I.Cells(TL(X), 7).End(xlDown).Value
    End If
    DEST.Offset(0, 4).Value = valeur 'récupère la [refValue] dans DEST déclalée de quatre colonnes à droite
    DEST.Offset(0, 2) = I.Cells(TL(X), 9).End(xlDown).Value 'récupère le [name] dans DEST déclalée de neuf colonnes à droite
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la lige suivante)
    If I.Cells(TL(X), 10).End(xlDown).Row < TL(X + 1) Then 'condition si la ligne de la première cellule non vide dans la colonne 10 (+X) est supérieure à la valeur de TL(X+1)
        'récupère la [description] dans DEST déclalée de deux colonnes à droite
        DEST.Offset(0, 3).Value = I.Cells(TL(X), 10).End(xlDown).Value
    End If 'fin de la condition (cete condition génère une erreur pour la dernière valeur du tableau TL)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'annule l'erreur
        'récupère la [description] dans DEST déclalée de deux colonnes à droite
        DEST.Offset(0, 3).Value = I.Cells(TL(X), 10).End(xlDown).Value
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
Next X 'prochaine valeur du tableau TL
'F.Sort.SortFields.Clear
'F.Sort.SortFields.Add Key:=Range("A1"), _
'    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'With F.Sort
'    .SetRange F.Range("A1:O738")
'    .Header = xlNo
'    .MatchCase = False
'    .Orientation = xlTopToBottom
'    .SortMethod = xlPinYin
'    .Apply
'End With
F.Select 'sélectionne l'onglet F
F.Range("A1").Select 'sélectionne A1 de l onglet F
End Sub

Le fichier :

 

[laurent950]

Re : boucle for avec variable comme fin

Bonjour le Forum,

Une solution avec variable tableau.

Macro Resultat

Sub Res()

' Feuil Source
Dim Init As Worksheet
Set Init = Worksheets("init")

' Derniere ligne non vide de la feuil source
fin = Init.Range("A65536").End(xlUp).Row

' Variable tableau source : feuil init
Dim T() As Variant
T = Init.Range(Init.Cells(5, 1), Init.Cells(fin, 18))
' Redimension du tableau T (Création de 5 colonnes en mémoire)
ReDim Preserve T(1 To UBound(T, 1), 1 To 23)

' Remplis les cases mémoires crée
' Boucle
For I = 1 To UBound(T, 1)
    If T(I, 5) <> "" Then
        T(I, 19) = T(I, 5)
        T(I, 20) = T(I + 1, 6)
        T(I, 21) = T(I + 3, 9)
        T(I, 22) = T(I + 3, 10)
        T(I, 23) = T(I + 2, 7)
    End If
Next I

' Feuil Resultat
Dim Res As Worksheet
Set Res = Worksheets("Rest")

' Création d'un compteur
Dim cpt As Long
cpt = 1
' Boucle d'extraction des valeurs du tableau T (Les 5 colonnes crées pécédement remplis)
' Puis coller dans la feuile resultat
For I = 1 To UBound(T, 1)
    If T(I, 5) <> "" Then
        Res.Cells(cpt, 1) = T(I, 19)
        Res.Cells(cpt, 2) = T(I, 20)
        Res.Cells(cpt, 3) = T(I, 21)
        Res.Cells(cpt, 4) = T(I, 22)
        Res.Cells(cpt, 5) = T(I, 23)
        cpt = cpt + 1
    End If
Next I

End Sub

laurent