Problème dans un code VBA

Bonjour,

Je reviens vers vous pour un autre problème dans un code VBA

Il s'agit de récupérer des données isssues d'autres feuilles d'un même classeur pour faire un "récapitulatif"

7test.xlsm (20.91 Ko)

Je cherche à récupérer dans l'onglet Récapitulatif les données issu des feuilles A, B et C.

Le problème par rapport à mon code c'est que je cherche à obtenir dans la cellule D11 "A et B" ou "B et A" mais je n'obtiens que B

J'ai donc un problème dans mon code....

Sub Camion_Ampirol()

Dim i As Integer
Dim k As Integer
Dim l As Integer
Dim Nom As String
Dim Nom1 As String

Range("C10:AD11") = ""
For j = 4 To 6
For l = 4 To 6
For i = 0 To 3
For k = 0 To 40
Nom = Worksheets("Liste").Cells(j, 3)
Nom1 = Worksheets("Liste").Cells(l, 3)

If Worksheets(Nom).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" And Not Worksheets(Nom1).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" Then
        If Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Bonnoron" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Denorme" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Deconinck" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Everard" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Interim" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Leupe" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Maniez" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Rommel" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Hogede" Then
            ActiveSheet.Cells(11, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k)
            ActiveSheet.Cells(10, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(1, 1)
        End If

ElseIf Worksheets(Nom).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" And Worksheets(Nom1).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" And j <> l Then
        If Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Bonnoron" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Denorme" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Deconinck" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Everard" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Interim" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Leupe" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Maniez" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Rommel" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Hogede" Then
            ActiveSheet.Cells(11, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k)
            ActiveSheet.Cells(10, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(1, 1) & " et " & Worksheets(Nom1).Cells(1, 1)
        End If
End If
Next
Next
Next
Next
End Sub

Tous les test avec Bonnoron, Denorme, Hogede.... sont les différentes valeurs que l'on pourrait retrouver dans la ligne 7, 9 ou 11 etc

Les variables j et l vont dans mon fichier de 4 à 22, je les ai réduits pour le fichier "exemple"

Je sais pas si je suis très clair...

Merci d'avance à ceux qui essaieront de m'aider

Cordialement

David

Bonsoir,

je n'ai pas tout compris, mais en cliquant rapidement plusieurs fois de suite sur le bouton, on voit apparaître les "A et B", les "B et A" mais pour finir sur "B". Le problème vient du fait que sur la feuille récapitulatif, toutes les données reste "figées" sur les lignes 10 et 11 !

Sub Camion_Ampirol()

Dim i As Integer
Dim k As Integer
Dim l As Integer
Dim Nom As String
Dim Nom1 As String

Range("C10:AD11") = ""
For j = 4 To 6
For l = 4 To 6
For i = 0 To 3
For k = 0 To 40
Nom = Worksheets("Liste").Cells(j, 3)
Nom1 = Worksheets("Liste").Cells(l, 3)

If Worksheets(Nom).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" And Not Worksheets(Nom1).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" Then
        If Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Bonnoron" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Denorme" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Deconinck" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Everard" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Interim" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Leupe" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Maniez" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Rommel" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Hogede" Then
            ActiveSheet.Cells(11, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k)
            ActiveSheet.Cells(10, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(1, 1)
        End If

ElseIf Worksheets(Nom).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" And Worksheets(Nom1).Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*" And j <> l Then
        If Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Bonnoron" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Denorme" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Deconinck" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Everard" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Interim" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Leupe" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Maniez" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Rommel" Or Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k) = "Hogede" Then
            ActiveSheet.Cells(11, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(7 + i * 2, 3 + 3 * k)
            ActiveSheet.Cells(10, 3 + (3 * k) / 3) = Worksheets(Nom).Cells(1, 1) & " et " & Worksheets(Nom1).Cells(1, 1)
        End If
End If
Next
Next
Next
Next
End Sub

ici ils sont surlignés

Le mieux et de les mettre en "variables" du style : Dim Ligne1 as long, Ligne2 as long

Ensuite avant les boucles : Ligne1 = 10

Ligne2=11

Et dès qu'une information est inscrite sur la feuille alors il faut les incrémentés pour passer une "double" ligne en dessous :

Ligne1 = Ligne1 + 2

Ligne2 = Ligne2 + 2

Après comme je vous l'ai dit, je n'ai pas tout compris, mais une chose est sur c'est que le code écrit "pardessus" ce qui existe déjà...

@ bientôt

LouReeD

Bonsoir,

Je suis d'accord avec l'explication de LouReed :

On détecte un premier changement colonne D10 A et B > Bonnoron pour l=5, i=1, et k =0 ou 1...

et ensuite comme les lignes ne s'incrémentent pas...

J'ai réécrit le code sous une forme qui me paraissait plus lisible

si tu veux l'utiliser :

Option Explicit
DefBool Y
Sub Camion_Ampirol()
Dim i%, j%, k%, x%, Nom$, Nom1$
Dim Y, YA, YB, a$(), c%
Dim WsLj As Worksheet, WsLx As Worksheet, WsR As Worksheet
Set WsR = Worksheets("Récapitulatif")
a = Split("Bonnoron Denorme Deconinck Everard Interim Leupe Maniez Rommel Hogede")
Range("C10:AD11") = ""
   For j = 4 To 6
      Nom = Worksheets("Liste").Cells(j, 3)
      Set WsLj = Worksheets(Nom)
      For x = 4 To 6
         Nom1 = Worksheets("Liste").Cells(x, 3)
         Set WsLx = Worksheets(Nom1)
         For i = 0 To 3
            For k = 0 To 40
               With WsLj
                  '------------réécriture des conditions
                  For c = 0 To UBound(a)
                     If .Cells(7 + i * 2, 3 + 3 * k) = a(c) Then
                        Y = True
                        Exit For
                     End If
                  Next
                  YA = WsLj.Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*"
                  YB = WsLx.Cells(6 + i * 2, 3 + 3 * k) Like "*Ampirol*"
                  '---------------------------------fin
                  If YA And Not YB Then
                     If Y Then
                         WsR.Cells(11, 3 + (3 * k) / 3) = .Cells(7 + i * 2, 3 + 3 * k)
                         WsR.Cells(10, 3 + (3 * k) / 3) = .Cells(1, 1)
                     End If
                  ElseIf YA And YB And j <> x Then
                     If Y Then
                         WsR.Cells(11, 3 + (3 * k) / 3) = .Cells(7 + i * 2, 3 + 3 * k)
                         WsR.Cells(10, 3 + (3 * k) / 3) = .Cells(1, 1) & " et " & WsLx.Cells(1, 1)
                     End If
                  End If
               End With
            Next
         Next
      Next
   Next
End Sub

A+

Tout d'abord merci à tous les deux.

Je suis d'accord avec toi LouReed sur ce que tu as exposé. C'est d'ailleurs pour cela que je demandais de l'aide, mais je n'ai pas du tout été clair ^^

Merci Galopin pour ton code, mais quand je l'utilise, je retrouve le même problème, si je tape assez vite sur le bouton je vois "B" et "B et A" apparaître mais c'est "B" qui finit par "s'imposer" alors que cela devrait être "B et A"

Si tu vois une solution à ça, je suis preneur

Merci d'avance

bonjour,

Si le but est juste de rechercher le B et A

tu mets un débranchement après la ligne :

WsR.Cells(10, 3 + (3 * k) / 3) = .Cells(1, 1) & " et " & WsLx.Cells(1, 1)
End

A+

Bonsoir à tous,

galopin01, je n'ai pas essayé ton code mais comme le dit davide ge, le problème reste le même... Je veux dire par là que le 10 et le 11 ne sont pas incrémentés, ni dans son code ni dans le tiens.

david ge je vous ai donné des brides de codes mais l'idée est là, juste sous vos yeux...

En fait après la ligne de code qui inscrit les données sur les lignes 10 et 11, vous mettez :

Ligne1 = Ligne1 + 2

Ligne2 = Ligne2 +2

Avant le code des différentes boucles imbriquées, vous initialisez les variables Ligne1 à 10 par Ligne1 = 10 et la variable Ligne 2 à 11 par Ligne2 = 11, et avant ceci vous les définissez par Dim Ligne1 as Long, Ligne2 as Long

Et dans le code qui inscrit les données sur la feuille, à la place de 10 vous inscrivez Ligne1, et à la place de 11 vous inscrivez Ligne2.

Du coup lorsque le code inscrit des données sur la feuille, les lignes sont incrémentées de deux pour être égale à 12 et 13, ce qui veut dire que le prochain résultat que le code trouvera sera inscrit deux lignes en dessous donc cela n'effacera pas ce qu'il y avait d'inscrit dans les cellules...

Ai-je été clair ?

@ bientôt

LouReeD

Rechercher des sujets similaires à "probleme code vba"