Problème boucle For

Le 03/07/2014 à 09:32

Bonjour,

Je bosse sur un projet que j'ai déjà pas mal avancé.

Mon code est bon (du moins fonctionne parfaitement) sur une colonne, mais maintenant j'ai besoin de d'utiliser la fonction For pour élargir tous mes calculs sur 12 colonnes supplémentaires.

Ici le code consiste à aller chercher les valeurs du classeur2 et de les exportés traités vers le classeur 1.

Sub NewDeal()
Dim Doc1, Doc2, C

    Set Doc1 = Workbooks("Classeur.xls").Sheets("Feuil1")
    Set Doc2 = Workbooks("Classeur2.xls").Sheets("Feuil1")

    Doc1.Range("G5:G66").Value = ""
    Doc1.Range("G74:G131").Value = ""
    Doc1.Range("G140:G181").Value = ""
    Doc1.Range("G183:G217").Value = ""

    Doc2.Activate

        For Each C In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)

        'DAT AVEC PRÉAVIS DE PLUS DE 32 JOURS / Particuliers
        If C.Offset.Value = "DAT_PREAVIS_32_JOURS" And C.Offset(0, 1).Value = "CPART" And C.Offset(0, 2).Value = "Assuré avec relation établie" Then
            Doc1.Cells(31, "G").Value = Application.Round((Doc1.Cells(31, "G").Value + C.Offset(0, 3).Value) / 1000, 0)
        End If
        If C.Offset.Value = "DAT_PREAVIS_32_JOURS" And C.Offset(0, 1).Value = "CPART" And C.Offset(0, 2).Value = "Assuré sans relation établie" Then
            Doc1.Cells(32, "G").Value = Application.Round((Doc1.Cells(32, "G").Value + C.Offset(0, 3).Value) / 1000, 0)
        End If
        If C.Offset.Value = "DAT_PREAVIS_32_JOURS" And C.Offset(0, 1).Value = "CPART" And C.Offset(0, 2).Value = "Non Assuré" Then
            Doc1.Cells(33, "G").Value = Application.Round((Doc1.Cells(33, "G").Value + C.Offset(0, 3).Value) / 1000, 0)
        End If
        Doc1.Cells(34, 7).Value = Application.WorksheetFunction.Sum(Doc1.Range("G31:G33"))        
    Next C

    Doc1.Activate
    Exit Sub

End Sub

Voici mon code, vous trouverez ci joints les fichiers sur lesquels je travail.

Le problème ici est donc d'étendre mon programme sur 12 colonnes supplémentaires, j'ai beau essayé dès que j'essaye de mettre

For i = 7 to 20 et de remplacer "G" par i cela fausse tous mes calculs...

Merci d'avance pour votre aide!

Romain.

5classeur1.zip (8.09 Ko)
4classeur2.zip (7.16 Ko)
Le 03/07/2014 à 14:28

A savoir que j'ai essayé en ajoutant

For i = 7 To 20,

Remplacer chaque "G" par i

Remplacer chaque C.Offset(0, 3).Value) par C.Offset(0, i - 1).Value)

Je ne sais plus du tout quoi essayer pour que ça marche car chaque fois que je fais ça mes résultats ne sont plus du tout les bons...

Le 03/07/2014 à 14:55

Bonjour,

Une possibilité :

Sub NewDeal()
Dim i%, k%, iC%, Doc1, Doc2, Y As Boolean

    Set Doc1 = Workbooks("CCible.xlsm").Sheets("Feuil1")
    Set Doc2 = Workbooks("CSource.xlsm").Sheets("Feuil1")
    Doc2.Activate
    With Doc1
      .Range("G5:T66").Value = ""
'      .Range("G74:G131").Value = ""
'      .Range("G140:G181").Value = ""
'      .Range("G183:G217").Value = ""
      i = Range("C" & Rows.Count).End(xlUp).Row 'Doc2

      For k = 2 To i
          For iC = 7 To 19
          Y = Cells(k, 3).Value = "DAT_PREAVIS_32_JOURS" And Cells(k, 4).Value = "CPART"
          'DAT AVEC PRÉAVIS DE PLUS DE 32 JOURS / Particuliers
            If Y And Cells(k, 5).Value = "Assuré avec relation établie" Then
               .Cells(31, iC).Value = Application.Round((.Cells(31, iC).Value + Cells(k, iC - 1).Value) / 1000, 0)
            End If
            If Y And Cells(k, 5).Value = "Assuré sans relation établie" Then
               .Cells(32, iC).Value = Application.Round((.Cells(32, iC).Value + Cells(k, iC - 1).Value) / 1000, 0)
            End If
            If Y And Cells(k, 5).Value = "Non Assuré" Then
               .Cells(33, iC).Value = Application.Round((.Cells(33, iC).Value + Cells(k, iC - 1).Value) / 1000, 0)
            End If
               .Cells(34, iC).Value = Application.WorksheetFunction.Sum(.Range(.Cells(31, iC), .Cells(33, iC)))
         Next
      Next
End With
    Doc1.Activate
End Sub

Nota : j'ai du renommer tes classeurs parce que des Classeur1 et Classeur2 j'en ai à plus savoir quoi en faire...

A+

Le 03/07/2014 à 14:58

Bonjour,

à tester

Sub NewDeal()
    Dim Doc1, Doc2, C

    Set Doc1 = Workbooks("Classeur1 (8).xls").Sheets("Feuil1")
    Set Doc2 = Workbooks("Classeur2 (1).xls").Sheets("Feuil1")

    Doc1.Range("G5:G66").Value = ""
    Doc1.Range("G74:G131").Value = ""
    Doc1.Range("G140:G181").Value = ""
    Doc1.Range("G183:G217").Value = ""

    Doc2.Activate

    For Each C In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)

        'DAT AVEC PRÉAVIS DE PLUS DE 32 JOURS / Particuliers
        If C.Offset.Value = "DAT_PREAVIS_32_JOURS" And C.Offset(0, 1).Value = "CPART" Then
            If C.Offset(0, 2).Value = "Assuré avec relation établie" Then
                lg = 31
            ElseIf C.Offset(0, 2).Value = "Assuré sans relation établie" Then
                lg = 32
            ElseIf C.Offset(0, 2).Value = "Non Assuré" Then
                lg = 33
            Else
             lg = 0
            End If
            If lg <> 0 Then
                For i = 7 To 20
                    Doc1.Cells(lg, i).Value = Application.Round((Doc1.Cells(lg, i).Value + C.Offset(0, i - 1).Value) / 1000, 0)
                Next i
                Doc1.Cells(34, i).Value = Application.WorksheetFunction.Sum(Doc1.Range(doc1.cells(31,i),doc1.cells(33,i)))
            End If
        End If
    Next C

    Doc1.Activate

End Sub
Le 03/07/2014 à 15:09

Merci d'avoir pris le temps de me répondre.

Je viens de tester le code et l'ordinateur me marque erreur 9' l'indice n'appartient pas à la selection.

Pourtant j'ai bien changer le nom de classeur1 et 2 avant de lancer la machine je ne comprend pas

Le 03/07/2014 à 15:13
Romain22950 a écrit :

Merci d'avoir pris le temps de me répondre.

Un problème cependant, quand j'essaye de le tester, même en remettant le nom des fichier comme il faut après Workbooks il me met Erreur 9' l'indice n'appartient pas à la selection.

Comment dois je faire?

vérifie tes noms de classeurs (y compris l'extension !) et de feuilles

ce message signifie qu'il ne trouve pas la feuille ou le classeur dans la ligne surlignée en jaune dans vba

il manque une parenthèse dans cette ligne

Doc1.Cells(34, i).Value = Application.WorksheetFunction.Sum(Doc1.Range(doc1.cells(31,i),doc1.cells(33,i)))
Le 03/07/2014 à 15:17

Ca marche!

Merci beaucoup ca fait au moins deux jours que je suis bloqué la dessus!!

A+

Rom

Rechercher des sujets similaires à "probleme boucle"