macro excel renvoyant toutes les valeurs d'une variable

eclipse008

XLDnaute Nouveau
bonjour a toutes et à tous

je me permets de vous déranger ici car j'ai besoin de votre aide

voila, imaginons, j'ai une feuille excel avec
Code:
colA   col B
A1         a
A1         b
A1         c
A2         b
A2         e
A3         f

et moi je voudrai avoir en résultat

Code:
col A     col B

A1         a,b,c
A2         b,e
A3         f

cad rechercher toutes les valeurs de la col A et leur associer dans une seule cellule les valeurs dans la colonne B correspondante

merci d'avance

cdlt


eclipse
 

porcinet82

XLDnaute Barbatruc
Re : macro excel renvoyant toutes les valeurs d'une variable

Salut,

Une petite macro qui nécessite que tes données soient triées selon la colonne A :
Code:
Sub test()
Dim k%, der_lig%
Dim tempo$
For k = 1 To Range("A65536").End(xlUp).Row
    der_lig = Range("E65536").End(xlUp).Row + 1
    If Cells(k, 1).Value = Cells(k + 1, 1).Value Then
        If tempo = "" Then
            tempo = Cells(k, 2).Value
        Else
            tempo = tempo & ", " & Cells(k, 2).Value
        End If
    Else
        If tempo = "" Then
            tempo = Cells(k, 2).Value
        Else
            tempo = tempo & ", " & Cells(k, 2).Value
        End If
        Cells(der_lig, 5).Value = Cells(k, 1).Value
        Cells(der_lig, 6).Value = tempo
        tempo = ""
    End If
Next k
End Sub

Le résultat est mis en colonnes E et F.

@+
 

jp14

XLDnaute Barbatruc
Re : macro excel renvoyant toutes les valeurs d'une variable

Bonsoir
Bonsoir porcinet82

Ci dessous une macro pour faire le travail demandée

Code:
Option Explicit
Sub travdemande()

Dim i As Long
Dim j As Long
Dim dl1 As Long
Dim dl2 As Long

Dim cellule As Range

Dim nomfeuille1 As String
Dim col1 As String
Dim classeur1 As String
Dim lidep1 As Long
Dim data1 As String
Dim adresse As String
Dim trouve As Boolean
'**********************************
nomfeuille1 = ActiveSheet.Name
col1 = "a"
lidep1 = 2
dl1 = Sheets(nomfeuille1).Range(col1 & "65536").End(xlUp).Row + 2

'************************************
With Sheets(nomfeuille1)
Do
If lidep1 = dl1 Then Exit Sub
For Each cellule In .Range(col1 & lidep1 & ":" & col1 & .Range(col1 & "65536").End(xlUp).Row)
     
     If trouve = False And cellule.Value <> "" Then
        data1 = cellule.Value
        trouve = True
        adresse = cellule.Address
    End If
    
     If cellule.Value = data1 And adresse <> cellule.Address And trouve = True Then
        .Range(adresse).Offset(0, 1) = .Range(adresse).Offset(0, 1) & "," & cellule.Offset(0, 1).Value
        cellule.Value = ""
        cellule.Offset(0, 1).Value = ""
    End If
    
Next cellule
    trouve = False
    lidep1 = lidep1 + 1
Loop

End With

End Sub

A tester

JP
 

Gael

XLDnaute Barbatruc
Re : macro excel renvoyant toutes les valeurs d'une variable

Bonsoir Eclipse008, Porcinet, JP14,

Un autre code possible. les valeurs initiales en A et B sont remplacées directement par le résultat:

Code:
Sub variable()
Dim tablo As Variant, i As Integer, k As Integer
tablo = ActiveSheet.Range("A1").CurrentRegion
k = 1
    For i = 2 To UBound(tablo)
        If tablo(i, 1) = tablo(i - 1, 1) Then
            tablo(k, 2) = tablo(k, 2) & "," & tablo(i, 2)
        Else
            k = k + 1
            tablo(k, 1) = tablo(i, 1)
            tablo(k, 2) = tablo(i, 2)
        End If
    Next i
        
ActiveSheet.Range("A1").CurrentRegion.Clear
ActiveSheet.Range("A1").Resize(k, 2) = tablo
End Sub

@+

Gael
 

eclipse008

XLDnaute Nouveau
Re : macro excel renvoyant toutes les valeurs d'une variable

merci pour vos réponses

j'ai une fonction beaucoup plus suimple dans le code

Code:
Function ConcatVLookUp(ByVal ValRecherche, _
                       ByVal TabMatrice As Range) As Variant
' Permet une recherchev sur des caractères génériques
'
Dim c As Range



Application.Volatile
 
For Each c In TabMatrice.Cells
    If c.Value Like ValRecherche Then
        ConcatVLookUp = ConcatVLookUp & "," & c.Offset(0, 1).Value
    End If
Next c
ConcatVLookUp = Mid(ConcatVLookUp, Len(",") + 1)
 
Set c = Nothing
End Function
[\code]

mais elle ralentit trop mon classeur et je voudrai l'optimiser afin d'accelerer mon classeur svp

merci de votre aide encore une fois

c vraiment très gentil de consacrer du temps a mon probleme
 

Discussions similaires

Réponses
7
Affichages
367

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 677
Messages
2 090 824
Membres
104 677
dernier inscrit
soufiane12