XL 2016 Problème avec array

[kingfadhel]

Bonsoir à tous,
J'ai un tableau mensuel (données brutes "DEF_GRH_2019_001.xlsx) que je dois le traiter par unités et par défaillances ....
J'ai aussi un classeur TBD sur lequel plusieurs tableau avec des détails
==> donc je dois importer les données brutes sur le TBD.
J'ai réussi à importer les données brutes dans un array, et j'ai réussi aussi extraire les données voulues et les stocker dans un array aussi,
le problème que je recontre est le suivant:
je ne réussi pas à transférer le tableau (array) dont je stock les données voulues à une feuille,
par contre dans la requête j'ai réussi à transférer les données voulues une par une dans la feuille.

Comment transférer les données stockées dans un array vers un emplacement spécifique exemple [A1]

 

[Hasco]

bonjour,

Pourquoi ne pas utiliser Range("A1").CopyFromRecordset Rst1 plutôt que GetRows

Et encore mieux, pourquoi ne pas utiliser Power Query fourni dans votre version excel ?

Dans le classeur joint vos données sont importées à partir de powerquery. Une cellule A1, nommée FichierExterne vous permet de mettre le chemin complet vers le fichier (FaItes le avant d'actualiser).


Cordialement

 

[kingfadhel]

Re,
Merci @Roblochon pour le temps alloué,
Au fait ce n'est pas moi qui va utiliser le classeur final, ça sera sur un ordinateur avec office 2007 et ça va comprendre plusieurs tableaux comparatifs et des tableaux de performances.
c'est pour ça que j'ai opté pour les arrays puisque après leurs parcours ils seront vidés et les résultats seront transférés sur les feuilles.

 

[Hasco]

Bonjour,

Alors utilisez la méthode CopyFromRecordset : Range("A1").CopyFromRecordset Rst1

Cordialement

 

[patricktoulon]

bonjour
si j'ai bien compris l'intention dans le code du xlsm
tu veux la colonne 12, 4 et 7 dans cet ordre a condition que ca corresponde au valeur de l'array
c'est bien ça ?

déjà je suis pas sur que le moteur jet soit bien indiqué
ensuite comme tu travail sur un tableau structuré il t'est facile de ne récupérer que les colonnes voulues au lieu de tout le tableau en entier (plus rapide)
il t'est aussi facile ensuite avec un test match par exemple sur ton array de reconstruire une variable tableau avec les lignes valides en incrementant une ligne mais en restant sur un ubound initial(prends moins de temps)

 

[patricktoulon]

re
bon voila
je me suis amusé un peu
voila un code fonctionnel et commenté
je précise j'ai testé !!!!

Sub testPatricktoulon()
    Dim Bd, arr, col&, ligne2&, x&
    ChDrive ThisWorkbook.Path: ChDir ThisWorkbook.Path
    Bd = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Selectionnez un  classeur source")    'dialog fichier

    If Bd = False Then MsgBox " operation de récupération annulée": Exit Sub    'on sort si on annule dans le dialog

    'valeur recherchée dans la colonne 12 du tableau structuré du fichier fermé
    arr = Array(3200000, 3000001, 3200020, 3200100, 3200110, 3200120, 3210000, 3212000, 3212010, 3212100, 3212110, 3212120, 3212200, 3212210, 3212220, 3212300, 3212310, 3212320, 3212400, 3212410, 3212420, 3212430, 3220000, 3220010, 3221000, 3221100, 3221110, 3221120, 3221200, 3221210, 3221220, 3222000, 3222100, 3222110, 3222120, 3222130, 3222200, 3222210, 3222220)


    With CreateObject("ADODB.Connection")    'on créée l'object ADODB.connection( en annonyme il sera detruit en sortie de end sub)
        Sql = "select [CDPOSTE],[DATE_DEBUT],[HEURE_DEBUT] from [Feuil1$]"    'l'argument de requete connerne certaines colonnes
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Bd & ";Extended Properties='Excel 12.0;HDR=Yes'"    'on ouvre adobd.connection
        tablo = .Execute(Sql).GetRows    ' on lui sinifie la requete et tablo prend les valeur des colonnes désirées
        .Close    'on ferme adobd.connection

        'on a maintenant un tableau de 3 lignes sur X colonnes

        ' on redim une nouvelle variable tableau  a l'inverse (x lignes et 3 colonnes)
        ReDim tablo2(1 To UBound(tablo, 2), 1 To 3)    'on redim notre tablo2 de destination direct sans transposer !!!!!!!

        For col = 0 To UBound(tablo, 2)    'on boucle sur les colonne du tablo issue de la requete

            x = Application.IfError(Application.Match(tablo(0, col), arr, 0), 0)    'test presence dans l'array de la valeur de la ligne 0  et colonne X de "tablo" (anciennement colonne 12 du tableau structuré)
           ' Debug.Print tablo(0, 20) & "--->" & x    ' juste pour controler que le match (positif ou negatif )seproduit bien
            If x > 0 Then    ' si presence on l'insert dans le tablo2 (les 3 valeur  mais transposées)
                ligne2 = ligne2 + 1
                tablo2(ligne2, 1) = tablo(0, col)
                tablo2(ligne2, 2) = tablo(1, col)
                tablo2(ligne2, 3) = tablo(2, col)
            End If

        Next
        'voila maintenant on a un tableau avec uniquement les valeurs désirée  de la colonne 12 du tableau structuré soit la colonne 0 due tablo
        ActiveSheet.[A1].Resize(, 3) = Array("CDPOSTE", "DATE_DEBUT", "HEURE_DEBUT")    'on met les entetes (facultatif)
        ' maintenant on resize A2 non pas au ubound du tablo2 mais ligne2 qui a été incrémenté tout au long de la boucle et sur 3 colonnes
        ActiveSheet.[A2].Resize(ligne2, 3) = tablo2
        'terminé pastis et saucisson c'est l'heure
    End With
End Sub

 

[dysorthographie]

Bonjour King,
et avec Mégane pas de problème?

Sub testdysorthographie()
    Dim Bd, arr, col&, ligne2&, x&
    ChDrive ThisWorkbook.Path: ChDir ThisWorkbook.Path
    Bd = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Selectionnez un  classeur source")    'dialog fichier

    If Bd = False Then MsgBox " operation de récupération annulée": Exit Sub    'on sort si on annule dans le dialog

    'valeur recherchée dans la colonne 12 du tableau structuré du fichier fermé
    arr = " (3200000, 3000001, 3200020, 3200100, 3200110, 3200120, 3210000, 3212000, 3212010, 3212100, 3212110, 3212120, 3212200, 3212210, 3212220, 3212300, 3212310, 3212320, 3212400, 3212410, 3212420, 3212430, 3220000, 3220010, 3221000, 3221100, 3221110, 3221120, 3221200, 3221210, 3221220, 3222000, 3222100, 3222110, 3222120, 3222130, 3222200, 3222210, 3222220)"


    With CreateObject("ADODB.Connection")    'on créée l'object ADODB.connection( en annonyme il sera detruit en sortie de end sub)
        Sql = "select [CDPOSTE],[DATE_DEBUT],[HEURE_DEBUT] from [Feuil1$] where [CDPOSTE] in" & arr   'l'argument de requete connerne certaines colonnes
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Bd & ";Extended Properties='Excel 12.0;HDR=Yes'"    'on ouvre adobd.connection
         'voila maintenant on a un tableau avec uniquement les valeurs désirée  de la colonne 12 du tableau structuré soit la colonne 0 due tablo
       
        ActiveSheet.[A1].Resize(, 3) = Array("CDPOSTE", "DATE_DEBUT", "HEURE_DEBUT")    'on met les entetes (facultatif)
         ActiveSheet.[A2].CopyFromRecordset .Execute(Sql)   ' on lui sinifie la requete et tablo prend les valeur des colonnes désirées
        .Close    'on ferme adobd.connection

    End With
End Sub

petite dédicace pour mon ami Patrick

 

[job75]

Bonjour à tous,

J'avoue ne pas comprendre pourquoi on parle de la colonne 12 alors que le tableau source n'en a que 10.

A+

 

[dysorthographie]

En fait moi non plus je voulais juste montrer à Patrick qu'il pouvait intégrer sont array sous forme de where in!

Je n'es pas regardé le code originel et je ne sais même pas si le demandeur souhaite un filtre sur certains code postaux.

 

[patricktoulon]

re
ouaip!! robert ok j’adhère
Attention au format de date quand même;les dates sont a gauche donc texte

@job75 "12" c'est par ce que dans son code on vois

  vDat1 = Rst1.GetRows
'--- Fermeture connexion 1 ---
    Set Rst1 = Nothing
    Cn1.Close
    Set Cn1 = Nothing
    x = 0
'Dim vDat2(3, 1)
    For i = 1 To UBound(vDat1, 2)
        For j = 1 To UBound(arr, 1)
        If vDat1(12, i) = arr(j) Then
        x = x + 1
        ReDim Preserve vDat2(1 To 3, 1 To x)
        vDat2(1, x) = vDat1(12, i)
        vDat2(2, x) = vDat1(4, i)
        vDat2(3, x) = vDat1(7, i)
        End If
        Next

mais en effet il n'y a que 10 colonnes
mais c'est pas important dans le sens ou on recupere les colonnes par le nom dans le "header"

 

[job75]

Oui on voit et il est facile de voir que vDat1 est un tableau en base 0 de 10 lignes et 2584 colonnes.

 

[kingfadhel]

Bonsoir à tous,
Merci d'avoir consacré du temps pour resoudre mon problème
au fait le 12 vient du premier tableau que j'en lui est supprimer 3 colonnes et je n'i pas mis à jour le code.

@job75, vDat1 réellement doit être transposer: 10 colonnes et 2584 lignes.

@dysorthographie je n'ai pas réussi à intégrer le where in dans ma requete.
Comme j'ai mentionné au début, le fichier récupéré et au format brut qui comprend plusieurs données inutiles pour moi, c'est fichiers qui comprend toutes les défaillances du personnel de la société (7546 agents) et ceux qui me concerne sont de l'ordre de 866 agents relatifs au unités citées dans l'array "arr".
donc chaque mois je dois récupérer leurs défaillances afin des les classés par type et par unités et par nombre de jours et les comparés à la même période de l'année précédente.
@patricktoulon votre code est fonctionnel, Merci.
@dysorthographie votre code aussi est fonctionnel.

J'ai reussi à faire ceci moyennant plusieures recherches sur la toile:

y'a t'il quelq'un qui peut reduire le code et meci encore une fois

Sub test_Array()
Dim varArray() As Variant
Dim i, j As Integer
Dim lrows As Long
Dim lcols As Long: Dim rng As Range
Range("a1:af120").ClearContents
lrows = Int((8 - 4 + 1) * Rnd + 4)
lcols = Int((6 * Rnd) + 1)
i = 0: j = 0
ReDim Preserve varArray(1 To lcols, 1 To lrows)
For i = 1 To lrows
    For j = 1 To lcols
    varArray(j, i) = i * j
    Cells(i, j + 9) = i * j
    Next
Next
For i = 1 To UBound(varArray, 2) ' - 1
For j = 1 To UBound(varArray, 1) ' - 1
Cells(i, j) = varArray(j, i)
Next
Next
Dim outputArr As Variant
outputArr = TransposeArray(varArray)
Set rng = Range(Cells(1, 1), Cells(lrows, lcols))
   rng = outputArr
End Sub
Function TransposeArray(MyArray As Variant) As Variant
    Dim x As Long, y As Long
    Dim maxX As Long, minX As Long
    Dim maxY As Long, minY As Long
    Dim tempArr As Variant
    'Get Upper and Lower Bounds
    maxX = UBound(MyArray, 1)
    minX = LBound(MyArray, 1)
    maxY = UBound(MyArray, 2)
    minY = LBound(MyArray, 2)
    
    'Create New Temp Array
    ReDim tempArr(minY To maxY, minX To maxX)
    'Transpose the Array
    For x = minX To maxX
        For y = minY To maxY
            tempArr(y, x) = MyArray(x, y)
        Next y
    Next x
    'Output Array
    TransposeArray = tempArr
    
End Function

 

[kingfadhel]

Bonjour King,
et avec Mégane pas de problème?

Généralement pas de problème, c'est une 1.5 DCI (SIEMENS), dernièrement j'ai déposé un nouveau moteur (le premier a accompli 430000 KM), et j'ai eu un problème de fuite d'huile niveau cache soupapes que j'espère régler le plutôt possible, sinon c'est une bombe dans la route.

 

[dysorthographie]

outputArr = application.transpose(varArray)

Comme simplification c'est bien non?

 

[patricktoulon]

bonjour
en effet application.transpose est plus simple
reste que transpose est limité en fonction de la mémoire et du type de donnée et non en fonction du nombre de ligne/colonnes comme beaucoup le croient
donc pour une BD il convient de se faire une fonction

donc exemple

Sub test_Array()
    Dim varArray(), i&, j&, lrows&, lcols&, rng As Range, outputArr
    Range("a1:af120").ClearContents
    lrows = Int((8 - 4 + 1) * Rnd + 4)
    lcols = Int((6 * Rnd) + 1)
    i = 0: j = 0
    ReDim Preserve varArray(1 To lcols, 1 To lrows) 'on dimentionne la variable  tableau
    'on alimente le tableau
    Randomize
    For i = 1 To lrows
        For j = 1 To lcols
            varArray(j, i) = Round(Rnd * 2000) 'avec des chiffre au hasard
        Next
    Next
       'on injecte la variable tableau dans la plage dimentionnée identiquement a la variable tableau
        Cells(1, 9).Resize(UBound(varArray), UBound(varArray, 2)) = varArray 'on injecte le tableau en un coup

     outputArr = TransposeArray(varArray) 'appel de la fonction de transposition
    'on dimentionne une plage a la dimention du tableau transposé
    Set rng = Cells(1, "A").Resize(UBound(outputArr), UBound(outputArr, 2)) '
    rng = outputArr 'on injecte la variable tableau transposée dans la plage
End Sub

Function TransposeArray(MyArray As Variant) As Variant
    Dim Col&, Lig&, Arr
     'dimentionnement de la variable tableau identiquement transposée
   ReDim Arr(LBound(MyArray) To UBound(MyArray, 2), LBound(MyArray) To UBound(MyArray))
    'on alimente la nouvelle variable tableau (ligne devient colonne et colonne devient ligne
    For Col = LBound(MyArray) To UBound(MyArray, 2)
        For Lig = LBound(MyArray) To UBound(MyArray)
            Arr(Col, Lig) = MyArray(Lig, Col)
        Next
    Next
    TransposeArray = Arr 'return
End Function

c'est pas plus compliqué