alligner des lignes en une seule en vba Fermé

Question

Bonjour,
je suis debutante en VBA, j'ai une petit souci et ça sera trop aimable de votre part si vous pourriez m'aider:
voilà , j'ai fait une macro en vba qui me recherche une valeur dans ma feuille de calcul. En trouvant cette valeur j'aligne la ligne à laquelle elle appartient et toutes les lignes qui suivent jusqu'à ce qu'il retrouve cette valeur de nouveau, là il fait la mème opération pour m'afficher les lignes qui suivent sur une seule ligne et ainsi de suite jusqu'à la fin de ma feuille,
voilà ce que j'ai fais:

Sub postraitement()
Dim ligne As Long, lig As Long
With ActiveSheet
derlig = .Range("A65536").End(3).Row
For ligne = 1 To derlig Step 1

FirstCar = Left(Range("A" & ligne).Value, 1)

If FirstCar = "I" Or FirstCar = "M" Or FirstCar = "E" Then

PMField = Mid(Range("A" & ligne).Value, 17, 8)
'jusq'ici j'ai trouver ma valeur et je l'ai ranger dans PMField mnt il faut

'copier la 1ère ligne
'tant que ligne ++ ne contient pas PMfield, copier
'sinon retourner au début du for et grouper les lignes qui suivent sur une autre ligne


End If
Next ligne
End With
End Sub

Je bloque sur la partie partie du regroupement des lignes qui suivent la ligne avec la condition en une seule et leur affichage dans une autre feuille du classeur
Je vous remercie d'avance.

thev · Answer

Un exemple serait le bienvenu pour éclaircir ta demande.

Utilisateur anonyme · Answer

Bonjour, 
voici un exemple
J'ai des lignes de cette forme :
----------------------------------------------------------------------------------------------------------------------              
I8921-0150      BGA350                 RB  BG24                 NR                                       950          
                            1884VCRV1    JA     D                                 420                                
                            1884VCRV1    WJ   GAI                FZ4              420 8921G0152                      
BGA350   

----------------------------------------------------------------------------------------------------------------------              
I8921-0151      BGA350                 RB  BG24                 NR                                       950          
                            1884VCRVB  A WJ   GAI                FZ5              420 8921G0152                      
                            1884VCRVB  A PA     D                                 420                                
BGA350   

----------------------------------------------------------------------------------------------------------------------     
         Chaque ligne est placée dans une seule cellule et non pas en colonnes. je cherche BGA350 , une fois je la trouve je groupe toutes les lignes qui viendront par la suite jusqu'à ce que je retrouve une deuxième  BGA350.  Je mets les lignes qui désormais sont groupées en une seule, dans ma 2ème feuille de calcul du mm classeur.
Je procède ainsi jusqu'à la fin de ma première feuille 
Pour chaque ligne , avant de la grouper avec celle qui la suit, je prends 102 caractères.
J'espère que j'etais un peu claire, mais je suis là pour tout coplement d'infos, 
merci d'avance

thev · Answer

par rapport à cet exemple, quel est le résultat attendu sur la feuille 2 (2 lignes ??)
 
I8921-0150 BGA350 RB BG24 NR 950 1884VCRV1 JA D 420 1884VCRV1 WJ GAI FZ4 420 8921G0152 BGA350
I8921-0151 BGA350 RB BG24 NR 950 1884VCRVB A WJ GAI FZ5 420 8921G0152  1884VCRVB A PA D 420

Utilisateur anonyme · Answer

wi c justement ça sauf qu'il  faut compter 102 caractère avec de concatener une ligne avec celle qui la suit

thev · Answer

voici un code fonctionnant avec l'exemple donné

Sub alignement()

Dim ligne As Integer
Dim colA_source As Range
Dim colA_destin As Range

Set colA_source = ActiveSheet.UsedRange.Columns("A").Rows
Set colA_destin = Worksheets(2).Columns("A").Rows

PMField = Empty
ligne = 0
For Each ligne_source In colA_source
    
    If Not IsEmpty(PMField) Then
        If ligne_source.Value <> PMField Then
            colA_destin(ligne).Value = colA_destin(ligne).Value & ligne_source.Value & String(104, " ")
        Else
            PMField = Empty
        End If
    End If
    FirstCar = Left(ligne_source.Value, 1)
    If FirstCar = "I" Or FirstCar = "M" Or FirstCar = "E" Then
        PMField = Mid(ligne_source.Value, 12, 6)
        ligne = ligne + 1
        colA_destin(ligne).Value = ligne_source.Value & String(104, " ")
    End If

Next ligne_source

End Sub

Utilisateur anonyme · Answer

Bonjour, 
ça marche , sauf qu'il ne prend pas en considération le 2ème BGA350 qui est juste avnt les tirets, et pui il prends mème les tirets en considération:
exemple:
 Il prends tout ça :
I8921-0152B     BGA350                 BT  TV24     B       FN0 NR                                       950                                                                                                                                              1884VCRV1    JA     F                                 420                                                                                                                                                                    1884VCRVB  A PA     F                                 420                                                                                                                                        BGA350                                                                                                                                                                                                                   ----------------------------------------------------------------------------------------------                                                                                                                     I8921-0152W     BGA350                 BT  TV24     W       FN0 NR                                       950

Au lieu de prendre rien que ça : 

8921-0152B     BGA350                 BT  TV24     B       FN0 NR                                       950                                                                                                                                              1884VCRV1    JA     F                                 420                                                                                                                                                                    1884VCRVB  A PA     F                                 420                                                                                                                                       
 BGA350    

En respectant que chaque ligne doit contenir 102 caractère avant de la concaténer avec celle qui la suit.

Merci d'avance.

thev · Answer

ci-joint code modifié en supposant que BGA350 est toujours le 2ème mot de la ligne commençant par I, M ou E.

Sub alignement()

Dim ligne As Integer
Dim colA_source As Range
Dim colA_destin As Range

Set colA_source = ActiveSheet.UsedRange.Columns("A").Rows
Set colA_destin = Worksheets(2).Columns("A").Rows

PMField = Empty
ligne = 0
For Each ligne_source In colA_source
    
    If Not IsEmpty(PMField) Then
        If ligne_source.Value <> PMField Then
            colA_destin(ligne).Value = colA_destin(ligne).Value & ligne_source.Value & String(102 - Len(ligne_source.Value), " ")
        Else
            PMField = Empty
        End If
    End If
    FirstCar = Left(ligne_source.Value, 1)
    If FirstCar = "I" Or FirstCar = "M" Or FirstCar = "E" Then
        mots_ligne = Split(ligne_source.Value, " ") 'scission ligne en mots séparés par espace
        PMField = mots_ligne(1)
        ligne = ligne + 1
        colA_destin(ligne).Value = ligne_source.Value & String(102 - Len(ligne_source.Value), " ")
    End If

Next ligne_source

End Sub

Utilisateur anonyme · Answer

Bonjour, 
tout dabord merci infiniment pour tes reponses, et pour l'interet que ta prété à ma demande d'infos.
j'ai executé le 2ème programme et ça donne une erreur "argument ou appel de procedure incorrect" sur la ligne :
colA_destin(ligne).Value = ligne_source.Value & String(102 - Len(ligne_source.Value), " ")


D'autre part, j'ai essayé de faire un programme et ça marche !! :D sauf que ça me donne un bug au niveau d'une seule ligne, le reste de la fueille s'affiche correctement et come je el souhaite, stp si tu pouvais me donner ton avis dessus
Voici le programme:
Sub postraitement()
Dim ligne As Long, lig As Long, ligne_sh1 As Long
Dim chaine As String
ligne_sh1 = 1
With ActiveSheet
'detecter la dernnière ligne non vide de la feuille
derlig = .Range("A65536").End(3).Row

For ligne = 1 To derlig Step 1

'détecter la première letter de la chaine de caractère
FirstCar = Left(Range("A" & ligne).Value, 1)
If FirstCar = "I" Or FirstCar = "M" Or FirstCar = "E" Then

'formattage de la ligne, recupération de la chaine utile(102 caractères)
chaine = Mid(Range("A" & ligne).Value, 1, 102)

'copier la 1ère ligne dans sheet "test"
Sheets("test").Cells(ligne_sh1, 1).Value = chaine

'récupérer les caractères 17 à 24 PMfield ( le BGA350 dans ce cas ) : Left(ligne)
PMField = Mid(Range("A" & ligne).Value, 17, 8)
lig = 1
toto = InStr(1, Cells(ligne + lig, 1).Value, PMField)
'toto renvoi 1 si la ligne contient PMfield , 0 sinon

'tant que ligne ++ ne contient pas PMfield (InStr),
While toto = 0
'formattage de la ligne
chaine = Mid(Cells(ligne + lig, 1).Value, 1, 102)
'copier la ligne en concaténant dans la feuille test
Sheets("test").Cells(ligne_sh1, 1).Value = Sheets("test").Cells(ligne_sh1, 1).Value & chaine

lig = lig + 1 'incrementer la boucle
testchaine = .Cells(ligne + lig, 1).Value
toto = InStr(1, PMField, testchaine)
'lig = lig
Wend

ligne_sh1 = ligne_sh1 + 1

'sinon retourner au début du for

End If
Next ligne
End With
End Sub

Alligner des lignes en une seule en vba

8 réponses

Discussions similaires