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

passage a une autre ligne

softimen

XLDnaute Nouveau
Bonjour tout le monde,

Je suis débutante en vba , et j'ai besoin de votre aide s'il vous plait .

J'ai cette macro qui permet de grouper les différents données pour deux mémés cellules qui se répètent sur plusieurs lignes.

Mon problème c'est que il regroupe les données seulement pour 2 lignes mais pas plus , je voudrai qui'il regroupe les données sur une mémé ligne qui ont les mémés cellule B et C qui se répètent sur plusieurs lignes .

J'arrive pas a trouver le pb dans mon code qui execute seulement pour 2 lignes .

Merci d'avance.





'code VBA


Function inserer(FL2 As Worksheet, lig As Integer, col As Integer)



If (FL2.Cells(lig, 20) <> "") Then
FL2.Cells(col, 19) = FL2.Cells(lig, 19)
FL2.Cells(col, 20) = FL2.Cells(lig, 20)
FL2.Cells(col, 21) = FL2.Cells(lig, 21)
FL2.Cells(col, 22) = FL2.Cells(lig, 22)



ElseIf (FL2.Cells(lig, 26) <> "") Then
FL2.Cells(col, 25) = FL2.Cells(lig, 25)
FL2.Cells(col, 26) = FL2.Cells(lig, 26)
FL2.Cells(col, 27) = FL2.Cells(lig, 27)



ElseIf (FL2.Cells(lig, 31) <> "") Then

FL2.Cells(col, 30) = FL2.Cells(lig, 30)
FL2.Cells(col, 31) = FL2.Cells(lig, 31)
FL2.Cells(col, 32) = FL2.Cells(lig, 32)


ElseIf (FL2.Cells(lig, 37) <> "") Then

FL2.Cells(col, 36) = FL2.Cells(lig, 36)
FL2.Cells(col, 37) = FL2.Cells(lig, 37)
FL2.Cells(col, 38) = FL2.Cells(lig, 38)

ElseIf (FL2.Cells(lig, 42) <> "") Then

FL2.Cells(col, 41) = FL2.Cells(lig, 41)
FL2.Cells(col, 42) = FL2.Cells(lig, 42)
FL2.Cells(col, 43) = FL2.Cells(lig, 43)


End If

End Function

Sub grouper()
Dim FL2 As Worksheet, i As Integer, j As Integer, h As String, lig As Integer, col As Integer
Set FL2 = Worksheets(4)

For i = 10 To 50
For j = 9 To i - 1
If ((FL2.Cells(i, 2) Like FL2.Cells(j, 2)) And (FL2.Cells(i, 3) Like FL2.Cells(j, 3)) And (FL2.Cells(i, 4) Like FL2.Cells(j, 4)) And (FL2.Cells(i, 5) Like FL2.Cells(j, 5))) Then
col = j
lig = i
h = inserer(FL2, lig, col)
Rows(i).Delete
End If
Next j
Next i
End Sub
 

softimen

XLDnaute Nouveau
Bonjour ,

Je reviens vers vous comme j'ai besoin d'une petite modification s'il vous plait et je serai trés reconnaissante .

en effet , je voudrais lors de fusion , si colonne Y <> " alors colonne S =colonne T
et si colonne AD <> "" alors colonne Y ET S = AD .

est ce que c'est fesable ?
'je vous joint un fichier pour mieux expliquer .

' code VBA
Function fusionner(FL2 As Worksheet, FromLigne As Integer, ToLigne As Integer)

For j = 19 To 44 'pour les colonnes S à AR
If FL2.Cells(FromLigne, j) <> "" Then 's'il y a quelque chose à recopier à partir de la ligne "FromLigne"
FL2.Cells(ToLigne, j) = FL2.Cells(ToLigne, j) & FL2.Cells(FromLigne, j)
Else
FL2.Cells(ToLigne, j) = FL2.Cells(ToLigne, j)
End If
Next j

End Function

Sub grouper()
Application.ScreenUpdating = False
Dim FL2 As Worksheet, i As Integer, j As Integer, h As String, FromLigne As Integer, ToLigne As Integer
Set FL2 = ActiveSheet 'Worksheets(4)
With FL2
FinFeuille = .Range("B" & .Rows.Count).End(xlUp).Row 'récupère la dernière ligne du tableau
For i = FinFeuille To 10 Step -1 'pour chaque ligne en partant du BAS
For j = i - 1 To 9 Step -1 'pour chaque ligne au dessus de la ligne i en cours
'si les colonnes BCDEF de la ligne i sont identiques
If ((.Cells(i, 2) Like .Cells(j, 2)) And (.Cells(i, 3) Like .Cells(j, 3)) And (.Cells(i, 4) Like .Cells(j, 4)) And (.Cells(i, 5) Like .Cells(j, 5))) Then
ToLigne = i 'le nom de la varialbe "Col" était quand meme très mal choisi.. vu qu'il s'agit aussi d'un numéro de ligne..
FromLigne = j
h = fusionner(FL2, FromLigne, ToLigne) 'le nom "inserer" prête à confusion, puisqu'il s'agit plutot de fusionner deux lignes....
Rows(j).ClearContents
'i = i - 1
End If
Next j
Next i
.Range("B9:B" & FinFeuille).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub



en vous remerciant d'avance
 

Pièces jointes

  • fichier exemple grouper.xlsm
    86 KB · Affichages: 37

vgendron

XLDnaute Barbatruc
Hello

dans ton fichier, tu n'as pas remis la bonne macro "Grouper"
je t'avais également proposé une autre macro "Grouper2" plus rapide. sur 20 lignes, la différence ne se fait pas sentir. mais sur 20 000.. ca risque d'être flagrant.

==> j'ai remis les deux dans le fichier, et j'ai corrigé les 2 pour les dates de fermetures (dernière demande)
 

Pièces jointes

  • fichier exemple grouper (1).xlsm
    106.8 KB · Affichages: 41

softimen

XLDnaute Nouveau
Bonjour ,

Merci beaucoup pour votre retour rapide .Vous étés très gentil .Vous avez raison , avec cette macro c'est plus rapide .
Sauf que j'ai pas compris l'esprit comme je suis debutant dans VBA , est ce que c'est possible de m'explique le code avec des commentaires s'il vous plait ?
pour aprés , je peux apprendre l'esprit de développement de ce deuxième code .

Je vous remercie ennormement pour votre aide et votre temps
 

softimen

XLDnaute Nouveau
Bonjour , j'ai besoin de votre aide comme vous etes fort en vba

mon probléme :

Ma macro fonctionne avec un Menu contextuel .Donc je voudrais quand utilisateur fini a remplir toute une ligne, après quand il clique sur le souris ou s'est nommé "duplication de la ligne " ; un message Box montre n° de trajet de début ,après un autre message Box ,n°de trajet de fin .
Donc a partir de n° trajet de début jusqu’au numéro de trajet de fin , il incrémente avec un +1 , avec recopie de toute la ligne .

'exemple :
N° trajet de debut :580
N) trajet de fin: 584
donc je voudrai avoir
581
582
583
584
avec coipe de tout les données de la ligne de n0 de trajet 581 de debut pour les autres numéros de trajet .
' code VBA
Sub dupliquerlignes()
Dim lignes As Integer
Dim debut As Integer
debut = InputBox("N° DE DEBUT ")
fin=InputBox("N °DE FIN ")
For Debut To Fin
With ActiveCell.EntireRow
.Offset(debut, 0).Insert Shift:=xlDown
.Copy Destination:=.Offset(debut, 0)
debut=debut+1
End With
Next debut
End Sub
' Menu contextuel

Private Sub Workbook_Open()
Call Creer_Menu_Contextuel_2
End Sub

Sub Creer_Menu_Contextuel_2()

'réinitialize la sourie comme à l'origine
Application.CommandBars("Cell").Reset

'Crée une commande dans le menu
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Duplication de la ligne" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "dupliquerlignes" 'appel de la macro

End With

End Sub

Sub reset_menudroit()
CommandBars("Cell").Reset
End Sub

j'espere que j'ai bien expliquer mon probléme .
Dans l'attente de vos répense .Je vous remercie d'avance
 

vgendron

XLDnaute Barbatruc
Voir PJ avec explications de la macro "Grouper2"
j'ai meme remis les formules en colonnes NOPQR
pour le reste. je regarde un peu plus tard.. Note: dans l'autre post que tu as ouvert, mets un lien vers celui ci. comme il s'agit du meme projet, autant rester ici.
 

Pièces jointes

  • fichier exemple grouper (1).xlsm
    108.8 KB · Affichages: 35

softimen

XLDnaute Nouveau
Bonjour Vgendron
Tout d'abord ,je vous remercie pour votre aide .
Pour mieux comprendre mon probleme de duplication ; je vous joint un fichier excel .
Dans l'attente de votre reponse .Merci
 

Pièces jointes

  • DUPLIQUER.xlsx
    11.3 KB · Affichages: 24

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…