Rangement d'un tableau

[faneva]

Bonjour,
J'ai besoin de votre aide pour le probleme suivant
j'ai tableau de type
2 b 1 e - -
1 a 4 f 2 y
4 d - - 5 z
3 c - - 3 w
je voudrais le mettre dans une autre feuille et de type
1 a e -
2 b - y
3 c - w
4 d f -
5 - - z
c'est à dire
les numeros seront rangés dans la colonne 1 par ordre croisssant

J'ai proposé ce code
Mais Lig = Application.WorksheetFunction.Match(libel, range("A:A"), 0), il marche pas


code

Dim Ligne As Integer



Dim l As Long
Dim c As Long





l = 2
c = 1

Dim i As Long
Dim j As Long
Dim lt As Long
Dim ct As Long
Dim lbel as long
Dim ltA As Long
Dim tablout1 As Variant
Dim tablout As Variant
Dim Lig As Integer




Set plage = range("a1:a" & range("a1").End(xlDown).Row)
nbrligne = plage.Cells.Count


colatraiter = 0
indice = 0
Ligne = 1
test = False
j = 1 UBound(tablout, 2) Step 2

i = 1 UBound(tablout, 1) step1


Do While (Worksheets("data").Cells(l, c).value <> "")
l = 2
Do While (Worksheets("data").Cells(l, c).value <> "")
'Do While Application.CountA(Sheets("data").Columns(c)) <> Application.CountA(Sheets("output").Columns(c))
colatraiter = c + 2
libel = Worksheets("data").Cells(l, c).value




value = Worksheets("data").Cells(l, colatraiter).value
If (value <> "") Then
If (value >= 2) Then

montab(indice, c) = libel
montab(indice, c) = ligne

ligne = ligne + 1


indice = indice + 1




Worksheets("output").Select
lt = Sheets("output").Cells(37500, j).End(xlUp).Row + 1
tablout = Sheets("output").range(Cells(1, 1), Cells(lt, ct)).value

ltA = UBound(tablout, 1)




lt = Sheets("output").range(ActiveCell, ActiveCell.End(xlUp)).Row + 1
ct = Sheets("output").range("a1").CurrentRegion.Columns.Count + 1





tablout1 = Sheets("output").range("a1", Cells(range("C65536").End(xlUp).Row)).value

For i = 1 To ltA
If Application.CountIf(range("A:A"), libel) > 0 Then
Lig = Application.WorksheetFunction.Match(libel, range("A:A"), 0)

tablout(Lig, j + 1) = cells(c,l)
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout

Else
tablout(ltA, 1) = libel
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout


End If
Next i



ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout

End If


End If





l = l + 1

Loop



c = c + 2
indice = 1
Ligne = 1


j = j + 1
l = 2
i = 1


Loop



End Sub






Merci pour votre aide

 

[mromain]

Re : Rangement d'un tableau

Bonjour à tous,

Voici une macro à adapter :

Sub Test()
Dim monDico As Object, tabID() As Variant, tabV() As Variant, zoneI As Range, zoneF As Range, i As Long, j As Long, k As Long, tmp As String

    'définir les zones
    Set zoneI = ThisWorkbook.Sheets("Feuil1").Range("A3:F6")
    Set zoneF = ThisWorkbook.Sheets("Feuil1").Range("J2")
    
    'vérifier que le tableau initial a bien un nombre pair de colonnes, sinon, quitter la macro
    If zoneI.Columns.Count Mod 2 = 1 Then
        MsgBox "Le tableau initial doit avoir un nombre pair de colonnes."
        Exit Sub
    End If
    
    'récupérer les identifiants sans doublons
    Set monDico = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For i = 1 To zoneI.Columns.Count Step 2
        For j = 1 To zoneI.Rows.Count
            If zoneI(j, i).Text <> "" Then monDico.Add zoneI(j, i).Text, zoneI(j, i).Text
        Next j
    Next i
    On Error GoTo 0
    tabID = WorksheetFunction.Transpose(monDico.Keys)
    
    'trier les identifiants
    For i = LBound(tabID) To UBound(tabID) - 1
        For j = i + 1 To UBound(tabID)
            If tabID(j, 1) < tabID(i, 1) Then
                tmp = tabID(i, 1)
                tabID(i, 1) = tabID(j, 1)
                tabID(j, 1) = tmp
            End If
        Next j
    Next i
    
    'récupérer les diférentes quantités
    ReDim tabV(LBound(tabID) + 1 To UBound(tabID) + 1, 1 To zoneI.Columns.Count / 2 + 1)
    For k = LBound(tabV, 1) To UBound(tabV, 1)
        tabV(k, 1) = tabID(k - 1, 1)
    Next k
    For i = 1 To zoneI.Columns.Count Step 2
        For j = 1 To zoneI.Rows.Count
            For k = LBound(tabV, 1) To UBound(tabV, 1)
                If zoneI(j, i).Text = tabV(k, 1) Then
                    tabV(k, (1 + i) / 2 + 1) = zoneI(j, i + 1).Text
                End If
            Next k
        Next j
    Next i
    
    'afficher le résultat
    zoneF.Resize(UBound(tabV, 1) - 1, UBound(tabV, 2)).Value = tabV
    
End Sub

a+

 

[faneva]

Re : Rangement d'un tableau

je n'y arrive pas
cordialement

 

[mromain]

Re : Rangement d'un tableau

Re,

Voici ton fichier avec la macro rajoutée.

a+

 

[GeoTrouvePas]

Re : Rangement d'un tableau

Bonjour mromain !

Tout simplement magnifique ta macro ! Un régal pour les yeux

A me faire regretter de pas prendre le temps de mieux maîtriser les collections, tableaux, dictionnaires........

 

[ROGER2327]

Re : Rangement d'un tableau

Bonjour à tous

Un essai...​

ROGER2327
#4374

Mardi 17 Haha 138 (Saint Homais d'Aquin, prudhomme, SQ)
1er Brumaire An CCXIX
2010-W42-5T14:21:13Z

 

[pierrejean]

Re : Rangement d'un tableau

Bonjour a tous

Uniquement pour montrer qu'il y a plusieurs chemins qui menent à Rome

 

[faneva]

Re : Rangement d'un tableau

Bonne nuit à tous,
je viens d'arriver et suis trés heureux de vos réponses.
Pour la proposition de mromain, il affiche l'erreur suivant "erreur 429
un composant Active X ne peut pas créer d'objet
Pour la proposition de Roger2327, les 2 marchent bien, mais je prefere le deuxième que je comprend mieux.
Je vais bosser pour l'adapter à mon cas
Merci encore, vous m'avez sauvé cette weekend
A bientôt

 

[faneva]

Re : Rangement d'un tableau

Bonjour,
Je reviens vers PierreJean à qui j'ai utilisé son 2ème methode.
Comme je ne maîtrise pas trés bien les tableaux, je ne m'en sors pas dés que je varie le nombre de colonnes des identifiants ainsi que le nombre de colonnes se rapportant sur les identifiants
Quelqu'un peut jeter un coup d'oeil sur mon code en feuille 2
Merci de votre aide

 

[pierrejean]

Re : Rangement d'un tableau

Re

Voila

 

[faneva]

Re : Rangement d'un tableau

merci beaucoup, çà marche

 

[faneva]

Re : Rangement d'un tableau

rebonsoir
aprés chaque reunion les données changent toujours.
Je m'abuse un peu de votre generosité mais le tableau se complique toujours
Les 2 premiers colonnes restent fixes ainsi que les 2 derniers
Pour les 4 valeurs inscrits dans 4 colonnes, on ne prends que les 3 (val1, val2 et val 4)
je le mets dans feuille essai. Les autres sont des brouillons
merci