Matrice carré à partir de n lignes*3colonnes

  • Initiateur de la discussion Initiateur de la discussion bLink
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

bLink

XLDnaute Nouveau
Bonjour tout le monde!
Je voudrai un macro dans laquelle si colle mes données, je pourrai avoir automatiquement une matrice carré n ligne et n colonnes.
En fait j'ai un document comme ci dessous:
A(zone origine) B(destination) C(nombre de déplacement)
1 1 a
1 2 0
1 3 b
. . .
. . .
1 .
2 1
2 2
. .
. .
84 84
Que je veux transformer pour avoir un document de la forme
O/D 1 2 3 4 . . . 84
1 a b k x
2 0 0 c d..... 0
3 a
.
.
.
84
Merci d'avance!!
 
Re : Matrice carré à partir de n lignes*3colonnes

Re

Ok, il est l'heure pour moi de me sustenter, je laisse donc le fauteuil à mes petits camarades de jeu (notamment ceux qui aiment bien titiller l'Array)

Je repasserai plus tard dans ton fil voir si une solution t'y aura été donné.
 
Re : Matrice carré à partir de n lignes*3colonnes

Bonsoir le forum,

une autre façon de procéder, avec l'objet ArrayList.
Fonctionne sur mon PC : Excel 2003, Windows XP
Résultat en Feuil1.
VB:
Sub Essai()
Dim a, i As Long, AL As Object, e
    Application.ScreenUpdating = False
    Set AL = CreateObject("System.Collections.ArrayList")
    With Range("A1").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not AL.Contains(a(i, 2)) Then AL.Add a(i, 2)
                If Not .exists(a(i, 1)) Then
                    Set .Item(a(i, 1)) = _
                    CreateObject("Scripting.Dictionary")
                End If
                .Item(a(i, 1))(a(i, 2)) = a(i, 3)
            Next
            AL.Sort
            ReDim a(1 To .Count + 1, 1 To AL.Count + 1)
            For i = 0 To AL.Count - 1
                a(1, i + 2) = AL(i)
            Next
            For i = 0 To .Count - 1
                a(i + 2, 1) = .keys()(i)
                For Each e In .items()(i).keys
                    a(i + 2, AL.IndexOf(e, 0) + 2) = IIf(.items()(i)(e) <> 0, .items()(i)(e), "")
                Next
            Next
        End With
        'Résultat sur la même feuille
        With .Offset(, .Columns.Count + 3).Resize(UBound(a, 1), UBound(a, 2))
            .CurrentRegion.Clear
            .Value = a
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .BorderAround ColorIndex:=1, Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Rows(1).Offset(, 1).Resize(, .Columns.Count - 1).Interior.ColorIndex = 40
            .Rows(1).BorderAround ColorIndex:=1, Weight:=xlThin
            .Columns(1).Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = 19
        End With
    End With
    Application.ScreenUpdating = True
End Sub
klin89
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
308
Réponses
5
Affichages
570
Réponses
10
Affichages
834
Retour