Casse-tête avec If

Le 03/06/2011 à 17:54

Bonjour le forum,

Dans le code ci-joint, pour une personne choisie via un userform avec une date de début et de fin, j'incrémente plusieurs totaux suivant les critères choisis.

Le problème qui se pose à moi, c'est que je copie systématiquement la ligne du fichier 2009Paiements vers 2009PUnDate si la personne est celle choisie, alors qu'il faudrait ne copier que les lignes de cette personne pour lesquelles une au moins des conditions If est vrai.

Par exemple pour la personne n°1 pour la période du 01/06/2010 au 31/12/2010, dans la configuration actuelle VBA copie toutes les lignes de cette personne de 2005 à 2011, alors qu'il ne doit copier les lignes que pour la période choisie si une au moins des dates de cette ligne dans les colonnes 5, 7, 10, 15, 17 ou 20 est comprise dans la période. Les totaux sont par contre justes.

J'ai retourné ça dans tous les sens, mais je ne sais comment le dire en VBA.

'Depuis la dernière ligne jusqu'à la ligne 6
    For i = LastRow To 6 Step -1
        'Si le N°RG de la feuille ("2009Paiements") correspond au protégé choisi
        If (Sheets("2009Paiements").Cells(i, 1)) = numeropro Then
            'CALCUL DES TOTAUX
            'Si la date de facturation du protégé est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTDPRO
            If CDate(Sheets("2009Paiements").Cells(i, 5)) >= CDate(EP5_DDEBUT) And CDate(Sheets("2009Paiements").Cells(i, 5)) <= CDate(EP5_DFIN) Then
            EP5MTDPRO = EP5MTDPRO + Sheets("2009Paiements").Cells(i, 6).Value
            End If
            'Si la date de paiement du protégé est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTPRO
            If CDate(Sheets("2009Paiements").Cells(i, 7)) >= CDate(EP5_DDEBUT) And CDate(Sheets("2009Paiements").Cells(i, 7)) <= CDate(EP5_DFIN) Then
            EP5MTPRO = EP5MTPRO + Sheets("2009Paiements").Cells(i, 8).Value
            End If
            'Si la date de rétrocession du protégé est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5RETROPRO
            If CDate(Sheets("2009Paiements").Cells(i, 10)) >= CDate(EP5_DDEBUT) And CDate(Sheets("2009Paiements").Cells(i, 10)) <= CDate(EP5_DFIN) Then
            EP5RETROPRO = EP5RETROPRO + Sheets("2009Paiements").Cells(i, 11).Value
            End If
            'Si la date de facturation du payeur est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTDPAY
            If CDate(Sheets("2009Paiements").Cells(i, 15)) >= CDate(EP5_DDEBUT) And CDate(Sheets("2009Paiements").Cells(i, 15)) <= CDate(EP5_DFIN) Then
            EP5MTDPAY = EP5MTDPAY + Sheets("2009Paiements").Cells(i, 16).Value
            End If
            'Si la date de paiement du payeur est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTPAY
            If CDate(Sheets("2009Paiements").Cells(i, 17)) >= CDate(EP5_DDEBUT) And CDate(Sheets("2009Paiements").Cells(i, 17)) <= CDate(EP5_DFIN) Then
            EP5MTPAY = EP5MTPAY + Sheets("2009Paiements").Cells(i, 18).Value
            End If
            'Si la date de rétrocession du payeur est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5RETROPAY
            If CDate(Sheets("2009Paiements").Cells(i, 20)) >= CDate(EP5_DDEBUT) And CDate(Sheets("2009Paiements").Cells(i, 20)) <= CDate(EP5_DFIN) Then
            EP5RETROPAY = EP5RETROPAY + Sheets("2009Paiements").Cells(i, 21).Value
            End If

            'PUIS INSERER UNE LIGNE SHEETS("2009PUnDate")
            Sheets("2009PUnDate").Rows(15).Insert
            'Et copier les données de chaque colonne
            For k = 1 To 22
            Sheets("2009PUnDate").Cells(15, k) = Sheets("2009Paiements").Cells(i, k)
            Next
            cptEP5 = cptEP5 + 1
        End If
    Next

Merci à vous

Amicalement

Joseph

Le 03/06/2011 à 18:14

Bonjour

Pas sur d'avoir compris (sans fichier )

Essayes

Sub test()
Dim Ok As Boolean

  'Depuis la dernière ligne jusqu'à la ligne 6
  With Sheets("2009Paiements")
    For i = LastRow To 6 Step -1
      Ok = False
      'Si le N°RG de la feuille ("2009Paiements") correspond au protégé choisi
      If (.Cells(i, 1)) = numeropro Then
        'CALCUL DES TOTAUX
        'Si la date de facturation du protégé est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTDPRO
        If CDate(.Cells(i, 5)) >= CDate(EP5_DDEBUT) And CDate(.Cells(i, 5)) <= CDate(EP5_DFIN) Then
          EP5MTDPRO = EP5MTDPRO + .Cells(i, 6).Value
          Ok = True
        End If
        'Si la date de paiement du protégé est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTPRO
        If CDate(.Cells(i, 7)) >= CDate(EP5_DDEBUT) And CDate(.Cells(i, 7)) <= CDate(EP5_DFIN) Then
          EP5MTPRO = EP5MTPRO + .Cells(i, 8).Value
          Ok = True
        End If
        'Si la date de rétrocession du protégé est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5RETROPRO
        If CDate(.Cells(i, 10)) >= CDate(EP5_DDEBUT) And CDate(.Cells(i, 10)) <= CDate(EP5_DFIN) Then
          EP5RETROPRO = EP5RETROPRO + .Cells(i, 11).Value
          Ok = True
        End If
        'Si la date de facturation du payeur est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTDPAY
        If CDate(.Cells(i, 15)) >= CDate(EP5_DDEBUT) And CDate(.Cells(i, 15)) <= CDate(EP5_DFIN) Then
          EP5MTDPAY = EP5MTDPAY + .Cells(i, 16).Value
          Ok = True
        End If
        'Si la date de paiement du payeur est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5MTPAY
        If CDate(.Cells(i, 17)) >= CDate(EP5_DDEBUT) And CDate(.Cells(i, 17)) <= CDate(EP5_DFIN) Then
          EP5MTPAY = EP5MTPAY + .Cells(i, 18).Value
          Ok = True
        End If
        'Si la date de rétrocession du payeur est comprise entre EP5_DDEBUT et EP5_DFIN j'ajoute sa valeur à EP5RETROPAY
        If CDate(.Cells(i, 20)) >= CDate(EP5_DDEBUT) And CDate(.Cells(i, 20)) <= CDate(EP5_DFIN) Then
          EP5RETROPAY = EP5RETROPAY + .Cells(i, 21).Value
          Ok = True
        End If

        If Ok = True Then
          'PUIS INSERER UNE LIGNE SHEETS("2009PUnDate")
          Sheets("2009PUnDate").Rows(15).Insert
          'Et copier les données de chaque colonne
          For k = 1 To 22
            Sheets("2009PUnDate").Cells(15, k) = .Cells(i, k)
          Next
          cptEP5 = cptEP5 + 1  ' A voir cette instruction AVANT/APRES le End If
        End If
      End If
    Next
  End With
End Sub
Le 03/06/2011 à 18:48

Bonjour Banzai64, le forum,

Rien à dire, voilà de la belle ouvrage.

Désolé pour le fichier, j'étais en train de le préparer (copie vers un autre fichier + rendre les données anonymes).

Le smiley était fâché tout rouge, j'espère que ce n'était pas le cas pour toi.

En plus je m'en veux, car quand j'étais en langage GAP sous AS400 (dans ma jeunesse !), j'en ai utilisé des "flag", et pas qu'un peu.

Ce qui étais vrai à l'époque se vérifie toujours et encore : à force de se casser les yeux à chercher le problème, rien ne vaux un regard extérieur pour trouver la solution.

Mille merci.

Amicalement

Joseph

Rechercher des sujets similaires à "casse tete"