Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

probleme de macro en vba

  • Initiateur de la discussion Initiateur de la discussion ZinebSa
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

ZinebSa

XLDnaute Nouveau
BJR, j'ai un petit souci je veux coder une macro qui cherche sur une colonne si il est ecrit sur la case non confirmé si c'est le cas elle recherche la case d'apres si elle est confirmé on doit créer un tableau sur la deuxieme feuille qui affiche les lignes de ces cas
VB:
Dim i As Integer
i = 4
Do Until Range("B4").End(xlDown).Row
If Range("B" & i).Value = Range("B" & i + 1).Value Then
If (Range("N" & i) = "IMPR LANC" Or Range("N" & i) = "CNFP CCOA IMPR LANC" Or Range("N" & i) = "CNFP IMPR LANC") And (Range("N" & i + 1) = "CONF IMPR LANC" Or Range("N" & i + 1).Value = "CONF CCOA IMPR LANC" Or Range("N" & i + 1) = "CONF IMPR LANC RECT") Then
'je ne sais pas quoi ecrire
i=i+1
End If
End If
Loop
j"ai fait un petit code et j'ai besoin d'aide pour le finir
 
re,

je sais que je ne sais pas comment expliquer ma situation et mes besoins

Ce n'est qu'en expliquant précisément ce que vous voulez obtenir, que vous pourrez obtenir de l'aide!

Avec ce que vous nous dites depuis le post #1, tout ce qu'on peut comprendre c'est que vous avez des difficultés avec un code qui ne fonctionne pas comme vous voulez ( et comme on ne sait pas ce que vous voulez ......)

A+
 
d'accord je vais vous expliquez :
1 - tester l'égalité de numéro d'ordre dans la colonne B
2- tester dans la colonne N :
Si la premiere cellule = "CONF ..." et la deuxieme cellule = "IMPR LANC"
on va faire une boucle qui teste les cellules d'aprés jusqu'à ce qu'elle trouve une cellule = "CONF ..." si c'est le cas on vas prendre les ligne dont les cellules sont entre la premiere et la derniere cellule = "CONF ..." et on enregistre dans la feuille 2 le num d'ordre ,Opération Work cntr,Statut système sinon (il n y'a pas de cellule = "CONF ..." aprés la cellule = "IMPR LANC' )
on n'enregistre rien
j'espere que c'est bien expliqué, merci d'avance et désolé
VB:
Dim i, j As Integer


For i = 4 To Range("B4").End(xlDown).Row

  'Test d'égalité d'OF
  If Range("B" & i) = Range("B" & i + 1) Then
 
    'Test des cas conf
    If Range("N" & i) = "CONF IMPR LANC" Then
   
    'MsgBox "la ligne " & i & " est confirmée"
   
      'Test des cas non-conf
      If Range("N" & i + 1) = "IMPR LANC" Then
     
      'MsgBox "la ligne " & i + 1 & " est non-confirmée"
     
              j = 1
             
              'Boucle de copie des cas non-conf
              While Range("N" & i + j) <> "CONF IMPR LANC" And Range("N" & i + j) <> ""
             
                j = j + 1
           
                MsgBox "la ligne " & i + j - 1 & " est non-Confirmée"
             
                'Copie des cas non-conf dans la feuille 2
                Sheets("Feuil1").Range("B" & i + j - 1).Copy Sheets("Feuil2").Cells(Rows.Count, 2).End(xlUp)(2)
                Sheets("Feuil1").Range("C" & i + j - 1).Copy Sheets("Feuil2").Cells(Rows.Count, 3).End(xlUp)(2)
                Sheets("Feuil1").Range("D" & i + j - 1).Copy Sheets("Feuil2").Cells(Rows.Count, 4).End(xlUp)(2)
                Sheets("Feuil1").Range("N" & i + j - 1).Copy Sheets("Feuil2").Cells(Rows.Count, 5).End(xlUp)(2)
             
              Wend
     
      End If
   
    End If
 
  End If

Next i
 

Pièces jointes

re,

je crois que je commence à comprendre !

en fait le résultat à obtenir est celui de la macro, du classeur du post #17, sauf qu'on ne devrait pas trouver la ligne pour
l'opération 9050? (et que ca fonctionne pour tous les ordres !)

Y a-t-il systématiquement un espace entre chaque ordre de la feuille Feuil1 ?

A+
 
Oui et entre chaque num d'ordre il y'a une ligne vide.
le principe et que si il y'a des opérations non confirmé = "IMPR LANC" entre deux opérations = "CONF IMPR LANC' on doit les copier dans la feuille 2
 
Re,

a tester :

dans un module standard:
Code:
Sub ZinebSa()
Dim i, j As Integer
Dim Deb As Long, Fin As Long, Copie As Boolean

With Sheets("Feuil1")
'For i = 4 To Range("B4").End(xlDown).Row
For i = 4 To .Range("B" & Rows.Count).End(xlUp).Row
    Copie = True
    'Test d'égalité d'OF
    If .Range("B" & i) = .Range("B" & i + 1) Then
        'Test des cas conf
        If .Range("N" & i) = "CONF IMPR LANC" Then
            'Test des cas non-conf
            If .Range("N" & i + 1) = "IMPR LANC" Then
                j = 1
                'détermine première ligne CONF... après la ligne "IMPR LANC"
                While .Range("N" & i + j) <> "CONF IMPR LANC" And .Range("N" & i + j) <> ""
                    j = j + 1
                    If .Range("N" & i + j) = "" Then Copie = False 'si on termine sans CONF.. il n'y a pas copie
                Wend
                If Copie Then
                    Deb = i + 1: Fin = i + j - 1
                    'Copie des cas non-conf dans la feuille 2
                    CopyConf Deb, Fin ' appel de la sub qui va copier
                End If
                i = i + j
            End If
        End If
    End If
Next i
End Sub

Code:
Sub CopyConf(iDeb, iFin)
For i = iDeb To iFin
    Sheets("Feuil1").Range("B" & i).Copy Sheets("Feuil2").Cells(Rows.Count, 2).End(xlUp)(2)
    Sheets("Feuil1").Range("C" & i).Copy Sheets("Feuil2").Cells(Rows.Count, 3).End(xlUp)(2)
    Sheets("Feuil1").Range("D" & i).Copy Sheets("Feuil2").Cells(Rows.Count, 4).End(xlUp)(2)
    Sheets("Feuil1").Range("N" & i).Copy Sheets("Feuil2").Cells(Rows.Count, 5).End(xlUp)(2)
Next
End Sub

A+
 
L
Merciii Bcp pour ton aide j'ai une autre question si c'est possible ???
 
Au niveau de l’événement SelectionChange je veux en cliquant sur la Cellule ("B" & i ) dans la Feuille 2 elle sélectionne la Cellule qui a la même valeur dans la Feuille 1 et qui est dans la même colonne
 
Re,

Donc rien à voir avec le reste de la discussion. Il y a peu de chance que quelqu'un découvre cette nouvelle demande enfouie au fond de 2 pages et 25 posts.

A+ sur une nouvelle discussion
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
301
Réponses
2
Affichages
222
Réponses
4
Affichages
217
Réponses
8
Affichages
487
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
544
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…