XL 2013 Reorganiser des donnes sur 3 colonnes en matrice

[Aussie_Thomas]

Bonjour,
Je dispose d'une feuille avec trois colonnes A, B et C, representant des coordonnees geographiques X,Y,Z qui representent une surface.
Je souhaite pouvoir reorganiser ces donnees sur une autre feuille pour avoir:
- X en colonne A
- Y en ligne 1
- Z qui sont recuperes automatiquement de ma feuille de base, en fonction de la ligne et la colonne ou l'on se trouve.

Je souhaite eviter de passer par une macro.

Ici la table que j'ai (j'ai plusieurs centaines de milliers de chiffres).

Ici comment je veux les trier:

Merci d'avance pour vos lumieres.

 

[Paritec]

Bonjour Aussiethomas le forum
pas de fichier alors en voilà un qui est du même style, (mais moi je ne referai pas ton tableau c'est sûr)
a+
Papou

 

[Aussie_Thomas]

Avec le fichier.
Merci d'avance

 

[Paritec]

Re Aussiethomas le forum
Re Bonjour Aussiethomas tu penses que ta pièce jointe de 18,6 MO c'est bien sérieux?????
moi avec ma connexion internet dans 2 heures c'est pas fini et j'ai pas de temps à perdre
voilà par rapport à ta première demande
a+
papou

 

[Paritec]

Bonjour Aussithomas le forum
Voilà tu mets cette macro dans ton fichier dans un module simple et tu lances la macro
et surtout tu t'armes de patience car 1084000 lignes à traiter !!!!!
je te joins cette macro car ton fichier ne possède pas une seule ligne vide et comme dans ma première macro je cherchais la première ligne vide en remontant cela n'allait pas, mais avec cette macro c'est OK, mais là patience, à mon avis tu es parti pour minimum 1 heure de traitement
a+
Papou

'Macro Faite par Pascal RICHARD Paritec le 30/05/2018
Option Explicit

Sub copie()
    Dim aa, i&, a&, bb, d As Object, n&, cc, dd, t$
    Set d = CreateObject("Scripting.Dictionary")
    t = Timer
    With Feuil1
        aa = .Range("A2:C" & Rows.Count)
    End With
    For i = 1 To UBound(aa)
        If aa(i, 1) <> "" And Not d.exists(aa(i, 1)) Then d.Add aa(i, 1), aa(i, 1)
    Next i
    bb = d.keys()
    d.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 2) <> "" And Not d.exists(aa(i, 2)) Then d.Add aa(i, 2), aa(i, 2)
    Next i
    cc = d.keys()
    ReDim dd(1 To UBound(bb) + 2, 1 To UBound(cc) + 2)
    For i = 0 To UBound(bb)
        dd(i + 2, 1) = bb(i)
    Next i
    For i = 0 To UBound(cc)
        dd(1, i + 2) = cc(i)
    Next i
    For i = 2 To UBound(dd)
        For a = 2 To UBound(dd, 2)
            For n = 1 To UBound(aa)
                If dd(i, 1) = aa(n, 1) And dd(1, a) = aa(n, 2) Then
                dd(i, a) = aa(n, 3): Exit For
                End If
            Next n
        Next a
    Next i
    Feuil2.Cells.Clear
    Feuil2.Range("A6").Resize(UBound(dd), UBound(dd, 2)) = dd
    MsgBox "Traitement Terminé en " & Format(Timer - t, "0.00 secondes")
End Sub

 

[job75]

Bonjour Aussie_Thomas, Papou,

là patience, à mon avis tu es parti pour minimum 1 heure de traitement

Mais non, avec cette macro :

Sub Remplissage()
Dim dur, t, ub&, d As Object, i&, X, Y, j%, n&, v$
t = Feuil1.[A1].CurrentRegion
ub = UBound(t)
Set d = CreateObject("Scripting.Dictionary")
dur = Timer
For i = 2 To UBound(t)
    If (i - 2) Mod 1000 = 0 Then _
    Application.StatusBar = "Préparation " & Format(i / ub, "0.0%") & " - " & Format((Timer - dur) / 86400, "hh:mm:ss"): DoEvents
    d(t(i, 1) & " " & t(i, 2)) = t(i, 3)
Next
dur = Timer
X = Feuil2.[A7:A1004]: Y = Feuil2.[B6:CVV6]: ub = UBound(X) 'à adapter si nécessaire
ReDim t(1 To ub, 1 To UBound(Y, 2))
For j = 1 To UBound(Y, 2)
    For i = 1 To ub
        n = n + 1
        If (n - 1) Mod 1000 = 0 Then _
        Application.StatusBar = "Remplissage " & Format(n / ub / UBound(Y, 2), "0.0%") & " - " & Format((Timer - dur) / 86400, "hh:mm:ss"): DoEvents
        v = X(i, 1) & " " & Y(1, j)
        If d.exists(v) Then t(i, j) = d(v)
Next i, j
Feuil2.[B7].Resize(ub, UBound(Y, 2)) = t 'restitution
End Sub

- la phase de préparation (création du Dictionary) prend 2 minutes

- le remplissage du tableau des résultats prend un peu moins de 10 minutes chez moi.

L'affichage de l'avancement dans la barre d'état fait prendre patience.

A+

 

[Paritec]

Bonjour Job le forum
bah moi a franchement parlé j'ai testé sur 10000 lignes pour contrôle du résultat.
Mais à mon sens cela aurait du être plus long que ce que tu dis, en tout état de cause long ou court la macro ne servira qu'une seule fois alors!!!
bonne journée
a+
Papou

 

[bcharef]

Bonjour Aussie_Thomas, Paritec et Job75
Bonjour à toutes et à tous.

Voici un essai avec un Tcd.

Salutations

 

[job75]

Bonjour Aussie_Thomas, Papou, bcharef, le forum,

@ Papou, je ne vois pas pourquoi la macro ne servirait qu'une fois, elle sert après toute modification de la feuille source.

@ bcharef, le TCD est sûrement une bonne solution mais ce n'est pas vraiment le problème posé.

Enfin j'ai modifié la macro du post #6 en utilisant d.exists :

        v = X(i, 1) & " " & Y(1, j)
        If d.exists(v) Then t(i, j) = d(v)

Le remplissage du tableau t s'effectue plus rapidement car il y a beaucoup de cellules vides.

Bonne journée.