Discussion :

[pat91]

Bonjour,

je cherche à réaliser en VBA un code pour éviter à avoir à saisir les formules dans une multitude de cellules.
je m'explique, je récupère une succession de valeurs (~32000) par nb matrices (X colonnes * Y lignes) séparées par une ligne vide.
je dois empiler les valeurs des matrices en une colonne en autant de colonnes que de matrices.
Pas facile à expliquer, je joins un fichier exemple commenté pour comprendre ma demande.
J'ai fais des recherches sur le forum mais pas trouvé chaussure à mon pied !
regardé les tutos mais du coup je n'ai plus les yeux en face

Je fais donc appel à vos connaissances et votre généreuse aide pour m'orienter dans ce dédale d'information.

Merci par avance.

[Gado2600]

Bonjour,

Si j'ai bien compris ton problème, il te faudrait passer par un index/equiv :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=INDEX($B$4:$F$7;EQUIV($F25;$G$4:$G$7;0);EQUIV($G25;$B$3:$F$3;0))

$F25 = "A" et $G25 = 1, par exemple.

Regardes de ce côté et restructure peut être un peu tes tableaux.

Cordialement,

[gus02800]

Bonjour,

Pourrais tu fournir 1 ou 2 fichiers que tu dois exploiter ? ce serait plus simple pour la compréhension.

Ci joint un bout de code comme j'ai compris, il ne reste qu'a remplacer le nom des feuilles ...


EnjOy

[ARTURO83]

Bonjour,

Vu la quantité de lignes X par le nombre de colonnes, à résoudre par formules, ça risque de peser lourd. Je vous propose une solution en VBA.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit
 
Sub Empilement()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim i As Long, DerCol_f1 As Long, DerLig_f1 As Long, DerLig_f2 As Long, DerCol_f2 As Long, DerLig_Mes As Long, Lig_f2 As Long, Col_f2 As Long, c As Long, Nb_Lig As Long, k As Long
    Dim m As Range, cell As Range
    Dim d As Object
    Dim Couleur As Long, Couleur1 As Long, Couleur2 As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("Synthese")
    f2.Cells.Clear
    Set d = CreateObject("Scripting.Dictionary")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    Col_f2 = 2
    For i = 1 To DerLig_f1
        Lig_f2 = 2
        With f1.Range("A1:A" & DerLig_f1)
            Set m = .Find("mesure " & i, lookat:=xlWhole)
            If Not m Is Nothing Then
                DerCol_f1 = f1.Cells(m.Row, 1).End(xlToRight).Column
                DerLig_Mes = f1.Cells(m.Row, "B").End(xlDown).Row
                For c = DerCol_f1 To 2 Step -1
                    For Each cell In Range(f1.Cells(m.Row + 1, c), f1.Cells(DerLig_Mes, c))
                        d.Add cell, ""
                    Next cell
                    f2.Cells(Lig_f2, Col_f2).Resize(d.Count, 1) = Application.Transpose(d.keys)
                    Lig_f2 = Lig_f2 + d.Count
                    d.RemoveAll
                Next c
                f2.Cells(1, Col_f2) = "Mesure " & i
                Col_f2 = Col_f2 + 1
            End If
        End With
    Next i
 
    'remplissage de la première colonne avec la position des relevés par ligne
    With f1.Range("A1:A" & DerLig_f1)
        Set m = .Find("mesure 1", lookat:=xlWhole)
        DerLig_Mes = f1.Cells(m.Row, "B").End(xlDown).Row
        DerCol_f2 = f2.Cells(2, 2).End(xlToRight).Column
        DerLig_f2 = f2.Columns("B").Find(what:="*", searchdirection:=xlPrevious).Row
 
        'Séparation des tranches de relevés par une alternance de couleurs
        Nb_Lig = DerLig_Mes - m.Row
        Couleur1 = 43
        Couleur2 = 4
        For k = 2 To DerLig_f2 Step Nb_Lig
            For i = 1 To DerLig_Mes 'Nb_Lig
                If f2.Cells(k + i - 1, "B") <> "" Then f2.Cells(k + i - 1, "A") = "Ligne " & i
            Next i
            If Couleur = Couleur1 Then Couleur = Couleur2 Else: Couleur = Couleur1
            Range(f2.Cells(k, 1), f2.Cells(k + Nb_Lig - 1, DerCol_f2)).Interior.ColorIndex = Couleur
        Next k
    End With
 
    Set m = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

le fichier
Pièce jointe 599899

Cdlt

[pat91]

Houaa!!

Bonjour et Merci à tous pour vos propositions

je me suis connecté ce matin pour comprendre le code de Gado2600 et je ne me suis pas re penché sur le post !

j'ai rapidement regardé vos solutions qui me semble répondre de façon différentes mais quel taf ! merci les gars

je regarde cela en détail ce soir

N'étant pas du tout un habitué de VBA, mais un passionné des chalenges j'ai pris ce projet.

Dans un premier temps, j’ai repris les tutos et les réponses sur la fonction « CONCATENATE » mais je suis largué dans l’utilisation des boucles imbriquer pour réaliser cette concaténation.
je souhaite concaténer dans une colonne les valeurs (numérique, 1 à 26) d’une colonne et les valeurs (string A à BL) d’une ligne.

En résumé j’ai dans une colonne les valeurs de 1 à 26 et sur une ligne les valeurs de A à BL et je souhaite écrire dans une colonne la suite concaténée des A1, B1,C1….jusqu’à BL62, BL63, BL64.
Soit 1664 ref de cellules.
Je joins un petit fichier d’exemple pour la compréhension du but recherché.

Merci encore pour votre aide spontanée

[ARTURO83]

Bonsoir,

Proposition, en premier lieu la solution avec le résultat obtenu en 3 étapes de la colonne A à C pour en comprendre le raisonnement, et enfin la solution avec une formule unique en colonne K.
Formules décomposées;
en colonne A:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=67-MOD(LIGNE()-5;64)

en colonne B:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=ENT((LIGNE()-5)/64)+1

en colonne C:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=INDIRECT(GAUCHE(ADRESSE(1;$A5;4);TROUVE(1;ADRESSE(1;$A5;4))-1)&4)&$B5

La formule unique en colonne K (un condensé des 3 autres):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=INDIRECT(GAUCHE(ADRESSE(1;67-MOD(LIGNE()-5;64);4);TROUVE(1;ADRESSE(1;67-MOD(LIGNE()-5;64);4))-1)&4)&$B5

Pièce jointe 599928

Cdlt