Condition non respecter alors que vrai ...?

Le 23/02/2022 à 14:19

Bonjour,

Je me retrouve face à un petit problème.

Lorsque j'exécute ma macro celle-ci vient normalement ranger dans la feuille VENTES_AMAZON les données de la feuille 2022-01.

Mais ma condition ne marche pas alors que même si celle-ci est vrai ( voir le classeur que j'ai joint pour un exemple ) ?

Sheets("VENTES_AMAZON").Range("C" & b).Value = Sheets(datedata1).Range("M" & a).Value

et donc passe directement à l'instruction suivante ...., en générant une nouvelle ligne alors qu'une ligne identique est déjà existant et devrait juste venir additionner les résultats.

Je vous remercie de votre aide.

Bonne journée

11classeur7.xlsm (37.10 Ko)
Sub test()

Dim DerniereCol1 As Integer
    Dim DerniereCol As Integer
    Dim datedata1 As String
    Dim derniereligne As Integer
    Dim derniereligne1 As Integer
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim D As Integer
    Dim decompte As Double
    Dim decompteunite As Double
    Dim decomptetotal As Double

    Application.ScreenUpdating = False

    Sheets("VENTES_AMAZON").Select

    DerniereCol1 = Cells(1, Columns.Count).End(xlToLeft).Column
    DerniereCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2
    derniereligne1 = Cells(Rows.Count, 1).End(xlUp).Row

    Range(Cells(1, DerniereCol1), Cells(derniereligne1, DerniereCol1 + 1)).Select
    Selection.Copy
    Range(Cells(1, DerniereCol), Cells(derniereligne1, DerniereCol + 1)).Select
    ActiveSheet.Paste
    Range(Cells(3, DerniereCol), Cells(derniereligne1, DerniereCol + 1)).Select
    Selection.ClearContents

    datedata1 = Sheets("INTERFACE").Range("B10").Value
    Cells(1, DerniereCol).Value = datedata1

    derniereligne = Sheets(datedata1).Cells(Rows.Count, 1).End(xlUp).Row

    Sheets("VENTES_AMAZON").Select

    For a = 2 To derniereligne

        For b = 4 To derniereligne1

            If Sheets("VENTES_AMAZON").Range("C" & b).Value = Sheets(datedata1).Range("M" & a).Value Then

                Sheets("VENTES_AMAZON").Range(Cells(b, DerniereCol)).Value = Sheets("VENTES_AMAZON").Range(Cells(b, DerniereCol)).Value + Sheets(datedata1).Range("Q" & a).Value
                Sheets("VENTES_AMAZON").Range(Cells(b, DerniereCol + 1)).Value = Sheets("VENTES_AMAZON").Range(Cells(b, DerniereCol + 1)).Value + Sheets(datedata1).Range("O" & a).Value

                Exit For

            Else

                For c = derniereligne1 To 4 Step -1

                    If Sheets(datedata1).Range("G" & a).Value = Sheets("VENTES_AMAZON").Range("B" & c).Value Then
                        D = c + 1
                        Rows(D & ":" & D).Select
                        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                        Sheets("VENTES_AMAZON").Range("B" & D).Value = Sheets(datedata1).Range("G" & a).Value
                        Sheets("VENTES_AMAZON").Range("C" & D).Value = Sheets(datedata1).Range("M" & a).Value
                        Sheets("VENTES_AMAZON").Range(Cells(D, DerniereCol)).Value = Sheets(datedata1).Range("Q" & a).Value
                        Sheets("VENTES_AMAZON").Range(Cells(D, DerniereCol + 1)).Value = Sheets(datedata1).Range("O" & a).Value

                        Exit For

                    End If

                Next c

            End If

        Next b

    Next a
Le 23/02/2022 à 18:39

Salut Cepafau,

ben, si, c'était fau...
Tu devais d'abord réaliser la boucle b complètement et noter dans une variable, ici iOK, si la condition avait été réalisée.
En fonction de iOK, tu exécutes alors seulement la 2e boucle., chose que je n'ai pas testée en l'état...

Sub test()
'
Dim sWkAMA As Worksheet, sWk1 As Worksheet
Dim iRowA%, iRow1%, iColA%, iTColA%, iCol1%
'
Dim D As Integer
Dim decompte As Double
Dim decompteunite As Double
Dim decomptetotal As Double

Application.ScreenUpdating = False
'
Set sWkAMA = Worksheets("VENTES_AMAZON")
Set sWk1 = Worksheets(CStr([IMPORT_SHEET]))
'
iRow1 = sWk1.Cells(Rows.Count, 1).End(xlUp).Row
With sWkAMA
    iColA = .Cells(1, Columns.Count).End(xlToLeft).Column
    iTColA = iColA + 2
    iRowA = .Cells(Rows.Count, 1).End(xlUp).Row
    '
    .Cells(1, iColA).Resize(iRowA, 2).Copy Destination:=.Cells(1, iTColA)
    .Cells(4, iTColA).Resize(iRowA, 2).ClearContents
    .Cells(1, iTColA) = [IMPORT_SHEET]
    '
    For a = 2 To iRow1
        iOK = 0
        For b = 4 To iRowA
            If .Range("C" & b).Value = sWk1.Range("M" & a).Value Then _
                .Cells(b, iTColA) = .Cells(b, iTColA) + sWk1.Range("Q" & a).Value: _
                .Cells(b, iTColA + 1) = .Cells(b, iTColA + 1) + sWk1.Range("O" & a).Value: _
                iOK = 1: _
                Exit For
        Next
        If iOK = 0 Then
            For c = derniereligne1 To 4 Step -1
                If sWk1.Range("G" & a).Value = .Range("B" & c).Value Then _
                    D = c + 1: _
                    .Rows(D & ":" & D).Select: _
                    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove: _
                    .Range("B" & D).Value = sWk1.Range("G" & a).Value: _
                    .Range("C" & D).Value = sWk1.Range("M" & a).Value: _
                    .Range(Cells(D, iTColA)).Value = sWk1.Range("Q" & a).Value: _
                    .Range(Cells(D, iTColA + 1)).Value = sWk1.Range("O" & a).Value
                    Exit For
            Next c
        End If
    Next
End With
'
End Sub
7classeur7.xlsm (36.01 Ko)


A+

Le 23/02/2022 à 22:14

Je t'avouerai que je suis un peu perdu dans la formulation de ton code XD

La condition est bien respecter mais la boucle ne marche plus, je vais voir si je peux corriger cela tout seul.

Merci beaucoup pour ton début d'aide

Le 23/02/2022 à 23:42

Salut Cepafau,

- j'ai eu le temps de regarder la boucle ELSE que j'ai légèrement transformée.

        If iOK = 0 Then _
            iTRow1 = .Columns(2).Find(what:=sWk1.Range("G" & a).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row + 1: _
            .Rows(iTRow1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove: _
            .Cells(iTRow1, 3).Resize(1, iTColA - 1).Borders.LineStyle = xlContinuous: _
            .Range("B" & iTRow1).Value = sWk1.Range("G" & a).Value: _
            .Range("C" & iTRow1).Value = sWk1.Range("M" & a).Value: _
            .Cells(iTRow1, iTColA).Value = sWk1.Range("Q" & a).Value: _
            .Cells(iTRow1, iTColA + 1).Value = sWk1.Range("O" & a).Value

- j'ai simplifié le travail de codage en aménageant les bordures de tes tableaux ;
- j'ai rectifié les formules, histoire que cela fonctionne après COPY ;
- pour le test, j'ai modifié quelques valeurs en '2022-01'.

Bref, ça fonctionne!
Reste à fixer une procédure de déclenchement de la macro : ALT-F8 n'est pas très pro !

8classeur7.xlsm (35.17 Ko)


A+

Le 24/02/2022 à 09:54

Merci beaucoup de ton aide, cela marche et en plus j'ai pu apprendre 2 3 trucs de codage :D

Le 24/02/2022 à 10:49

Salut Cepafau,

ça fonctionnera en l'état tant que tu n'auras pas un nouveau "amazon.XXX" auquel cas une erreur sera levée.
Y en aura-t-il d'autres ?


A+

Le 24/02/2022 à 13:21

Salut curulis,

Oui, je suis au courant, je n'ai pas voulu mettre de régle pour remplir cette condition pour éviter de me prendre la tête^^.

Car cela ne devrait pas arriver et dans le pire des cas, je l'implémenterai manuellement pour que la macro puisse fonctionner :D

+

Rechercher des sujets similaires à "condition respecter que vrai"