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 Job75,


A d'accord c'est surement l'origine de la différence

Pour ma part Windows 8
Et Microsoft Office 365 avec Excel 2013

Malheureusement c'est la version d'Excel installée chez nous


Comment pourrais-je remplacer votre code pour dimensionner correctement mon tableau qui peut faire jusqu'à 100 colonnes et 1000 lignes environ ?


Bien cordialement

Daniel
 

job75

XLDnaute Barbatruc
Juste pour vérifier dites-moi ce que ça donne chez vous avec :
VB:
 Nnum = Application.Count(.Cells) 'nombre de cellules numériques
Sinon on peut se passer de la variable Nnum, voyez ce fichier (4) et la macro :
VB:
Private Sub Worksheet_Activate()
Dim F As Worksheet, lig1&, lig2&, col1%, col2%, col3%, col4%, col5%
Dim ncol%, tablo, resu(), i&, j%, n&
'---à partir des noms définis---
Set F = [ID].Parent
lig1 = [ID].Row
lig2 = [Sup_100].Row
col1 = [ID].Column
col2 = [Nom_1].Column
col3 = [Nom_2].Column
col4 = [Sup_100].Column
For col5 = col4 To F.Columns.Count
    If Val(Replace(CStr(F.Cells(lig2, col5)), ",", ".")) < 100 Then Exit For
Next col5
col5 = col5 - 1
'---définition des tableaux---
With F.Range("A1", F.UsedRange)
    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 F.Rows.Count, 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---
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
Sur votre macro ça donne :
VB:
Sub test()
    Dim F As Worksheet, ncol%, tablo, resu()
    Set F = ActiveSheet
    With F.Range("A1", F.UsedRange)
        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 F.Rows.Count, 1 To 6)
    F.Range("F1").Value = "Ca marche"
End Sub
 

Pièces jointes

  • Tableau(4).xlsm
    21.3 KB · Affichages: 1

Daniel Desch

XLDnaute Nouveau
Bonsoir,

Oui pourtant j'ai renouvelé mon abonnement pack office 365 récemment
Je n'avais pas spécialement vu que l'excel qui allait avec n'était qu'un Excel 2013. Je pensais que l'on avait droit systématiquement à la nouvelle version
A moins qu'il ne faille tout réinstaller pour obtenir un 2019

Ceci dit comme ça j'ai la même version que les utilisateurs ce qui d'un autre côté est un avantage

Sur ce je vais dormir

Bonne nuit

Daniel
 
Haut Bas