Problème avec If Then Else

Le 10/06/2021 à 18:34

Bonjour

J'ai une macro qui a pour but :

- Si les n° anonymes et montant sont identiques entre deux tableaux, alors on ajoute juste la case commentaire

- Sinon on ajoute la ligne en réorganisant dans les colonnes du fichier de destination

Malheureusement, je ne comprends pas pourquoi dans mon code, quand la condition 1 est remplie la condition deux (après le Else) se fait quand même. Cela créait des doublons dans mon tableau....

With classeurSource.Worksheets("Fichier Final")

For i = 2 To classeurSource.Worksheets("Fichier Final").Cells(2, 1).End(xlDown).Row

'identifier la derniere ligne fichier destination

derligne = classeurDestination.Worksheets("Renouvellements").[C2].End(xlDown).Row

For j = 1 To derligne

If classeurSource.Worksheets("Fichier Final").Cells(i, 1).Value = classeurDestination.Worksheets("Renouvellements").Cells(j, 2).Value And classeurSource.Worksheets("Fichier Final").Cells(i, 4).Value = classeurDestination.Worksheets("Renouvellements").Cells(j, 8).Value Then

classeurDestination.Worksheets("Renouvellements").Cells(j, 11).Value = classeurDestination.Worksheets("Renouvellements").Cells(j, 11).Value & Chr(13) & Chr(10) & classeurSource.Worksheets("Fichier Final").Cells(i, 11).Value

Else

classeurDestination.Worksheets("Renouvellements").Range("B" & derligne + 1) = classeurSource.Worksheets("Fichier Final").Cells(i, 1).Value

classeurDestination.Worksheets("Renouvellements").Range("C" & derligne + 1) = classeurSource.Worksheets("Fichier Final").Cells(i, 10).Value

classeurDestination.Worksheets("Renouvellements").Range("F" & derligne + 1) = classeurSource.Worksheets("Fichier Final").Cells(i, 2).Value

classeurDestination.Worksheets("Renouvellements").Range("G" & derligne + 1) = classeurSource.Worksheets("Fichier Final").Cells(i, 3).Value

classeurDestination.Worksheets("Renouvellements").Range("H" & derligne + 1) = classeurSource.Worksheets("Fichier Final").Cells(i, 4).Value

classeurDestination.Worksheets("Renouvellements").Range("I" & derligne + 1) = classeurSource.Worksheets("Fichier Final").Cells(i, 5).Value

classeurDestination.Worksheets("Renouvellements").Range("K" & derligne + 1) = classeurSource.Worksheets("Fichier Final").Cells(i, 11).Value

End If

Next

Next

End With

Pouvez vous m'aider ?

9test-1.xlsx (9.64 Ko)
11testj.xltm (26.61 Ko)
Le 11/06/2021 à 00:16

bonsoir,

je n'obtiens pas le problème que tu décris. Mais je vois un autre problème, c'est que ta feuille renouvellement ne reçoit pas tous les nouveaux renouvellements.

une proposition pour corriger ce problème.

Sub extraire()

    Application.ScreenUpdating = False

    Dim classeurSource As Workbook, classeurDestination As Workbook
    Dim i As Long
    Dim j As Long
    Dim derligne As Long
    Dim ligneVide As Long, nf As String

    'définir le classeur source
    Set classeurSource = ActiveWorkbook
    'définir le classeur destination

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Please select one or more excel files"
        .Filters.Clear
        .Filters.Add "Excel files", "*.XLS*"
        If .Show = True Then
            nf = .SelectedItems(1)
        Else
            MsgBox "no files selected"
            Exit Sub
        End If
    End With
    Set classeurDestination = Application.Workbooks.Open(nf)

    'identifier la derniere ligne fichier destination
    derligne = classeurDestination.Worksheets("Renouvellements").Cells(Rows.Count, "B").End(xlUp).Row
    'définir la premier ligne vide
    ligneVide = derligne + 1

    'Pour chaque colonne de la ligne
    With classeurSource.Worksheets("Fichier Final")
        For i = 2 To classeurSource.Worksheets("Fichier Final").Cells(2, 1).End(xlDown).Row 'derniere cellule renseignée de la colonne?
            For j = 2 To classeurDestination.Worksheets("Renouvellements").Cells(5, 2).End(xlDown).Row

                If classeurSource.Worksheets("Fichier Final").Cells(i, 1).Value = classeurDestination.Worksheets("Renouvellements").Cells(j, 2).Value And classeurSource.Worksheets("Fichier Final").Cells(i, 4).Value = classeurDestination.Worksheets("Renouvellements").Cells(j, 8).Value Then
                    classeurDestination.Worksheets("Renouvellements").Cells(j, 11).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 11).Value
                    Exit For

                End If
            Next
            If j >= ligneVide Then
                classeurDestination.Worksheets("Renouvellements").Cells(ligneVide, 2).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 1).Value
                classeurDestination.Worksheets("Renouvellements").Cells(ligneVide, 3).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 10).Value
                classeurDestination.Worksheets("Renouvellements").Cells(ligneVide, 6).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 2).Value
                classeurDestination.Worksheets("Renouvellements").Cells(ligneVide, 7).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 3).Value
                classeurDestination.Worksheets("Renouvellements").Cells(ligneVide, 8).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 4).Value
                classeurDestination.Worksheets("Renouvellements").Cells(ligneVide, 9).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 5).Value
                classeurDestination.Worksheets("Renouvellements").Cells(ligneVide, 11).Value = classeurSource.Worksheets("Fichier Final").Cells(i, 11).Value
            ligneVide = ligneVide + 1
            End If
        Next
    End With

    'copier les données de la "Feuil1" du classeur source vers la "Feuil1" du classeur destination
    'classeurSource.Sheets("Données").Range("A2:F9999").Copy Destination:=classeurDestination.Sheets("FEUIL1").Range("A2")

    Application.ScreenUpdating = True
    'sauvegarder le classeur destination sans message
    'Application.DisplayAlerts = False
    'classeurDestination.Save
    'Application.DisplayAlerts = True

End Sub
Le 11/06/2021 à 05:35

Bonjour H2so4 et merci pour le temps que vous m'accordez

Je compte essayer votre code dans la matinée. mais de ce que je comprends je vais avoir un problème...

Je me rends compte avec votre commentaire que mon fichier avec macro est pas le bon.... Je vous joins donc le bon.

Pour ce qui est du probleme, est en relation avec le fichier TEST1 :

- La macro créer une ligne pour les 3 premiers clients du tableau de "Fichier Final" alors qu'ils existent, et que selon ma boucle il devrait seulement ajouter le commentaires...

-J'ai donc au final des doublons, j'ai comme l'impression qu'il ne prend pas en compte mon Else. Est ce que la solution serait de quitter la boucle j comme vous le faites dans votre proposition ?

Merci encore une fois, et désolé pour l'erreur qui doit vous avoir fait perdre du temps.

5testj-xltm.xlsm (24.21 Ko)
Le 11/06/2021 à 08:19

Bonjour,

la macro devrait bien solutionner ton problème. Je me suis laissé avoir par tes données exemples, organisées de telle sorte qu'il n'y avait pas de doublon.

Le 11/06/2021 à 08:36

Après test, ça semble parfaitement fonctionner. Je dois faire quelques tests pour être sûr.

Merci beaucoup, je tournais complètement en rond sur la réflexion.

Cordialement

Rechercher des sujets similaires à "probleme then else"