XL 2013 Conversion tableau 2 dimensions en tableau 1 dimension

Daniel Desch

XLDnaute Nouveau
Bonjour,

On me fournit des tableaux deux dimensions du type de celui présenté en feuille 1

Je souhaite à partir de ça générer un tableau une dimension du type de celui présente en feuille 2 (dans l'idéal dans la version présentée en I, J, K donc en éliminant les valeurs vides, nulles, non numériques ou égales à zéro, mais sinon la version présentée en colonne A, B, C serait déjà un gros progrès). L'objectif étant de charger la feuille générée dans une base de données externe, style MySql


Sachant que le tableau présenté en Feuille 1 pourrait se trouver à n'importer où dans la feuille excel, il serait bien que sa position soit quelque part en paramètre.
D'autre part le tableau peut avoir un nombre quelconque de lignes et de colonnes


Vous remerciant par avance pour votre aide


Cordialement
 

Pièces jointes

  • Tableau 2 dimensions en tableau 1 dimension.xlsx
    9.8 KB · Affichages: 7
Dernière édition:

Daniel Desch

XLDnaute Nouveau
Bonsoir,

Je suis désolé, je ne sais pas comment appeler ça, je peux changer le titre de la discussion mais ne sais pas trop quoi mettre...

Mais il s'agit d'un cas assez fréquent de conversion je pense. En tout cas j'en ai plusieurs à traiter dans ce style là pour alimenter des bases de données avec des données récupérées dans des tableaux excel du même style présentant des tableaux de ce type.

Cordialement
 

job75

XLDnaute Barbatruc
Bonsoir Daniel Desch, JB, patricktoulon,

Si le tableau en Feuil1 est tout seul on peut utiliser le UsedRange pour le repérer, voyez cette macro dans le code de Feuil2 :
VB:
Private Sub Worksheet_Activate()
Dim Nnum&, ncol%, tablo, resu(), i&, j%, v As Variant, n&
With Feuil1.UsedRange 'CodeName de la 1ère feuille
    Nnum = Application.Count(.Value) 'nombre de valeurs numériques
    If Nnum = 0 Then GoTo 1
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'sécurité, au moins 2 éléments
    tablo = .Resize(, ncol) 'matrice, plus rapide
End With
ReDim resu(1 To Nnum, 1 To 3)
For i = 2 To UBound(tablo)
    For j = 2 To ncol
        v = tablo(i, j)
        If IsNumeric(CStr(v)) Then
            If v <> 0 Then
                n = n + 1
                resu(n, 1) = tablo(i, 1)
                resu(n, 2) = tablo(1, j)
                resu(n, 3) = v
            End If
        End If
Next j, i
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
A+
 

Pièces jointes

  • Tableau(1).xlsm
    19.7 KB · Affichages: 5

Daniel Desch

XLDnaute Nouveau
Bonjour Boisgontier,

La fonction décaler() a l'air très puissante mais les tableaux à traiter étant un peu tordus, des tests vont être à rajouter pour éliminer certaines données donc je pense qu'une macro vba sera plus appropriée.
En tout cas merci beaucoup de m'avoir fait découvrir cette fonction intéressante.



Bonjour Job75,

Merci beaucoup pour cette macro qui est très condensée et rapide. L'idée d'un tableau intermédiaire me semble très bonne. Elle fait très bien son affaire quand le tableau à traiter est tout seul sur la feuille excel. Malheureusement ce n'est pas le cas pour la grande majorité des feuilles que je vais devoir traiter. Je soumets un nouvel exemple un peu plus compliqué ci-joint. Dans cet exemple ce que je sais :
- C'est que la colonne A de ma nouvelle feuille est à prendre à partir de E16 vers le bas (jusqu'à trouver une case avec une valeur non numérique ou nulle, ici E21)
- Les colonnes B et C sont des attributs de la première colonne que je trouve ici respectivement en F16 et dessous et en H16 et dessous
- La colonne D sera constituée à partir de la portion de ligne de J13 vers la droite jusqu'à rencontrer une case vide (ici P13)
- La colonne E ce sont les cases intersection ligne/colonne

Etant relativement débutant dans les macros excel (je n'ai fait jusqu'à présent qu'adapter des macros enregistrées), j'ai par exemple du mal à partir de E16 de faire une boucle vers le bas jusqu'à trouver la première case non numérique ou à partir de J13 rechercher la première case vide vers la droite, toutes choses qui me permettrait de dimensionner un tableau pour y enregistrer des données que je pourrais alors retranscrire facilement dans une nouvelle feuille de la façon qui me convient

Vous remerciant par avance de vos retours

Cordialement
 

Pièces jointes

  • Tableau 2 dimensions en tableau 1 dimension V2.xlsx
    11.6 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour Daniel Desch, le forum,

Dans ce fichier (2) voyez les 4 noms définis et cette macro :
VB:
Private Sub Worksheet_Activate()
Dim F As Worksheet, lig1&, lig2&, col1%, col2%, col3%, col4%, col5%
Dim Nnum&, ncol%, tablo, resu(), i&, j%, n&
'---à partir des noms définis---
Set F = [ID].Parent
lig1 = [ID].Row
lig2 = [Nom_3].Row
col1 = [ID].Column
col2 = [Nom_1].Column
col3 = [Nom_2].Column
col4 = [Nom_3].Column
col5 = F.Cells(lig2, F.Columns.Count).End(xlToLeft).Column
'---définition des tableaux---
With F.Range("A1", F.UsedRange)
    Nnum = Application.Count(.Value) 'nombre de valeurs numériques
    If Nnum = 0 Then GoTo 1
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'sécurité, au moins 2 éléments
    tablo = .Resize(, ncol) 'matrice, plus rapide
End With
ReDim resu(1 To Nnum, 1 To 5)
'---remplissage du tableau des résultats---
For i = lig1 To UBound(tablo)
    If Not IsNumeric(CStr(tablo(i, col1))) Then Exit For
    For j = col4 To col5
        If IsNumeric(CStr(tablo(i, j))) Then
            n = n + 1
            resu(n, 1) = tablo(i, col1)
            resu(n, 2) = tablo(i, col2)
            resu(n, 3) = tablo(i, col3)
            resu(n, 4) = tablo(lig2, j)
            resu(n, 5) = tablo(i, j)
        End If
Next j, i
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'à adapter
    If n Then .Resize(n, 5) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
A+
 

Pièces jointes

  • Tableau(2).xlsm
    22.4 KB · Affichages: 1

Daniel Desch

XLDnaute Nouveau
Merci beaucoup Job75,


Votre macro est vraiment compacte, super puissante et adaptable à plein de cas de figure pour exporter des données excel vers des bases de données.


Une petite question complémentaire, admettons qu'au lieu de :
PierrePaulJacquesErnestEmileLouis
je veuille prendre la ligne

10832​
15041​
3300​
23​
121,5​
7,54​
Mais m'arrêter non pas aux cases vides mais dès qu'une valeur est inférieur à 100 (par conséquent ici uniquement les 3 premières colonnes


Comment calculer col5 ? que mettre à la place de ?
col5 = F.Cells(lig2, F.Columns.Count).End(xlToLeft).Column

(c'est surement facile, mais je suis un peu nul...)

Merci en tout cas pour tout

Daniel
 
Dernière édition:

job75

XLDnaute Barbatruc
Voyez ce fichier (3), il suffit de définir col5 comme ceci :
VB:
For col5 = col4 To F.Columns.Count
    If Val(Replace(CStr(F.Cells(lig2, col5)), ",", ".")) < 100 Then Exit For
Next col5
col5 = col5 - 1
 

Pièces jointes

  • Tableau(3).xlsm
    22.4 KB · Affichages: 4
Dernière édition:

Daniel Desch

XLDnaute Nouveau
Bonjour job75,

J'ai un petit problème avec votre code ci-dessous qui fonctionne en général très bien mais qui plante quand les utilisateurs ont la mauvaise idée de mettre du texte sur plus de 256 caractères dans une case

Ce qui plante c'est l'instruction :
Nnum = Application.Count(.Value) 'nombre de valeurs numériques
qui se termine en erreur 13.

Il suffit d'une case ainsi dans un tableau de 100 colonnes et 1000 lignes pour que ça plante

Je ne sais pas comment modifier votre code pour que ça ne plante plus
Vous remerciant par avance pour votre retour

Cordialement

Daniel



Bonsoir Daniel Desch, JB, patricktoulon,

Si le tableau en Feuil1 est tout seul on peut utiliser le UsedRange pour le repérer, voyez cette macro dans le code de Feuil2 :
VB:
Private Sub Worksheet_Activate()
Dim Nnum&, ncol%, tablo, resu(), i&, j%, v As Variant, n&
With Feuil1.UsedRange 'CodeName de la 1ère feuille
    Nnum = Application.Count(.Value) 'nombre de valeurs numériques
    If Nnum = 0 Then GoTo 1
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'sécurité, au moins 2 éléments
    tablo = .Resize(, ncol) 'matrice, plus rapide
End With
ReDim resu(1 To Nnum, 1 To 3)
For i = 2 To UBound(tablo)
    For j = 2 To ncol
        v = tablo(i, j)
        If IsNumeric(CStr(v)) Then
            If v <> 0 Then
                n = n + 1
                resu(n, 1) = tablo(i, 1)
                resu(n, 2) = tablo(1, j)
                resu(n, 3) = v
            End If
        End If
Next j, i
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
A+
 

job75

XLDnaute Barbatruc
Bonsoir Daniel Desch,

Application.Count c'est la fonction Excel NB et mettre un texte de plus de 256 caractères dans une cellule ne l'empêche pas de fonctionner.

A priori l'erreur que vous indiquez ne peut pas se produire puisque Nnum est déclarée As Long (&), il faudrait joindre votre fichier.

De toute façon les bugs entraînés par les bêtises des utilisateurs sont salutaires : ça leur apprend à vivre.

A+
 

Daniel Desch

XLDnaute Nouveau
Bonsoir Job75

Voici un exemple très simple pour prouver ce que j'avance

Avec la feuille "Bon", la macro test() s'exécute sans problème
Avec la feuille "Pas bon", la macro test() plante en erreur 13

La macro est pourtant très simple et tirée de votre code :

VB:
Sub test()
    Dim F As Worksheet, Nnum&, ncol%, tablo, resu()
    Set F = ActiveSheet
  
    With F.Range("A1", F.UsedRange)
        Nnum = Application.Count(.Value) 'nombre de valeurs numériques
        If Nnum = 0 Then GoTo 1
        ncol = .Columns.Count
        If ncol = 1 Then ncol = 2 'sécurité, au moins 2 éléments
        tablo = .Resize(, ncol) 'matrice, plus rapide
    End With
    ReDim resu(1 To Nnum, 1 To 6)
    F.Range("F1").Value = "Ca marche"
1
End Sub
 

Pièces jointes

  • Exemple planté.xls
    142.5 KB · Affichages: 2
Haut Bas