Alligner des lignes en une seule en vba
Utilisateur anonyme
-
Utilisateur anonyme -
Utilisateur anonyme -
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.
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.
A voir également:
- Alligner des lignes en une seule en vba
- Partager des photos en ligne - Guide
- Mètre en ligne - Guide
- Comment imprimer un tableau excel sur une seule page - Guide
- Mettre une seule page en paysage word - Guide
- Formulaire en ligne de meta - Guide
8 réponses
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
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
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
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
wi c justement ça sauf qu'il faut compter 102 caractère avec de concatener une ligne avec celle qui la suit
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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.
ç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.
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
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
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
