Tableau VBA Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
m
matimatfr
Membre habitué
Membre habitué
Messages : 73
Appréciations reçues : 3
Inscrit le : 14 novembre 2016
Version d'Excel : 2010 FR

Message par matimatfr » 6 janvier 2020, 15:12

Bonjour à toutes et à tous,

Pour commencer, je vous souhaite mes meilleurs vœux pour cette nouvelle année 2020.

Je vous sollicite car je suis coincé sur une macro, peut être que je procède mal pour celle-ci. J'avais crée un macro afin de boucler sur une base de données (appelée PLANNING 2020 dans le fichier ci-joint) pour la transformer en tableau afin d'en faire un ou plusieurs TCD. Le résultat se rapportant dans l'onglet "Table". Là, pas de soucis, tout fonctionne bien.

La base de données est amener à évoluer en ajoutant des colonnes (appelée PLANNING 2020B dans le fichier). J'ai essayé d'adapter ma macro pour ajouter une boucle et avoir le résultat dans "Table2") là je me retrouve avec un problème de mémoire insuffisante. Ça ne fonctionne plus. Si vous avez une idée... Merci d'avance pour votre aide.

Voici les macro :

Macro qui fonctionne
Public Sub Create_Table()
Dim wb As Workbook
Dim wsData As Worksheet, wsTable As Worksheet
Dim lo As ListObject
Dim Cell As Range
Dim tbl, Arr()
Dim I As Long, J As Long, k As Long

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("PLANNING 2020")
    Set wsTable = wb.Worksheets("Table")
    Set lo = wsTable.ListObjects(1)

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set Cell = .InsertRowRange.Cells(1)
    End With

    tbl = wsData.Cells(1).CurrentRegion.Value
    For I = 2 To UBound(tbl)
        For J = 13 To UBound(tbl, 2)
            If tbl(I, J) <> "" Then
                ReDim Preserve Arr(12, k + 1)
                Arr(0, k) = tbl(I, 1)
                Arr(1, k) = tbl(I, 2)
                Arr(2, k) = tbl(I, 3)
                Arr(3, k) = tbl(I, 4)
                Arr(4, k) = tbl(I, 5)
                Arr(5, k) = tbl(I, 6)
                Arr(6, k) = tbl(I, 7)
                Arr(7, k) = tbl(I, 8) & ", " & tbl(I, 9)
                Arr(8, k) = tbl(I, 10)
                Arr(9, k) = tbl(I, 11)
                Arr(10, k) = tbl(I, 12)
                Arr(11, k) = CLng(tbl(1, J))
                Arr(12, k) = tbl(I, J)
                k = k + 1
            End If
        Next J
    Next I

    If k > 0 Then Cell.Resize(k, 13).Value = Application.Transpose(Arr)
    lo.HeaderRowRange.EntireColumn.AutoFit
Macro qui fonctionne pas
Public Sub Create_Table2()
Dim wb As Workbook
Dim wsData As Worksheet, wsTable As Worksheet
Dim lo As ListObject
Dim Cell As Range
Dim tbl, Arr()
Dim I As Long, J As Long, k As Long, Q As Long

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("PLANNING 2020B")
    Set wsTable = wb.Worksheets("Table2")
    Set lo = wsTable.ListObjects(1)

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set Cell = .InsertRowRange.Cells(1)
    End With

    tbl = wsData.Cells(1).CurrentRegion.Value
    For I = 2 To UBound(tbl)
      For Q = 11 To 20
        For J = 22 To UBound(tbl, 2)
            If tbl(I, J) <> "" Then
                ReDim Preserve Arr(13, k + 1)
                Arr(0, k) = tbl(I, 1)
                Arr(1, k) = tbl(I, 2)
                Arr(2, k) = tbl(I, 3)
                Arr(3, k) = tbl(I, 4)
                Arr(4, k) = tbl(I, 5)
                Arr(5, k) = tbl(I, 6)
                Arr(6, k) = tbl(I, 7)
                Arr(7, k) = tbl(I, 8) & ", " & tbl(I, 9)
                Arr(8, k) = tbl(I, 10)
                Arr(9, k) = tbl(1, Q)
                Arr(10, k) = tbl(I, Q)
                Arr(11, k) = tbl(I, 21)
                Arr(12, k) = CLng(tbl(1, J))
                Arr(13, k) = tbl(I, J)
                k = k + 1
            End If
        Next J
      Next Q
    Next I

    If k > 0 Then Cell.Resize(k, 14).Value = Application.Transpose(Arr)
    lo.HeaderRowRange.EntireColumn.AutoFit

End Sub
excelpratique.xlsm
(441.99 Kio) Téléchargé 12 fois
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 305
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 6 janvier 2020, 20:51

Salut

Meilleurs vœux à toi aussi.

Quel est ton objectif exactement. Remplir la colonne compétence de la table2 à partir des colonnes K à T de Planning 2020B ?

Jers
m
matimatfr
Membre habitué
Membre habitué
Messages : 73
Appréciations reçues : 3
Inscrit le : 14 novembre 2016
Version d'Excel : 2010 FR

Message par matimatfr » 7 janvier 2020, 09:17

Bonjour Jers et merci de ta réponse.

Oui c'est bien ça, remplir la colonne compétences en fonction des colonnes K à T et la colonne Valeur en fonction des mêmes valeurs.

En fait obtenir ça.
table excel pratique.JPG
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'180
Appréciations reçues : 630
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 7 janvier 2020, 10:37

Bonjour,
Je connais cette procédure !... ;;)
Pourquoi ne pas traiter tes données avec Power Query ?
Il y une requête dans ton classeur !?
Power Query est à privilégier pour nettoyer les données (Crap data).
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
m
matimatfr
Membre habitué
Membre habitué
Messages : 73
Appréciations reçues : 3
Inscrit le : 14 novembre 2016
Version d'Excel : 2010 FR

Message par matimatfr » 7 janvier 2020, 10:41

Bonjour Jean Eric.

Et oui, la solution Power Qerry serait la plus aisée, et c'est sûr ça solutionne tout mon problème.

Mais, car il y a un mais :) , les collaborateurs pour qui je travaille non pas Power Querry, ça ne sera pas installé par la DSI actuelle (du moins pas de suite) et donc impossible pour eux de mettre à jour la requête.

D'où ma problématique vba :wink:
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 305
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 7 janvier 2020, 21:30

Salut,

Je te propose cela
For I = 2 To UBound(tbl)
        For J = 22 To UBound(tbl, 2)
            ListeCompetence = ""
            If tbl(I, J) <> "" Then
                ReDim Preserve Arr(13, k + 1)
                Arr(0, k) = tbl(I, 1)
                Arr(1, k) = tbl(I, 2)
                Arr(2, k) = tbl(I, 3)
                Arr(3, k) = tbl(I, 4)
                Arr(4, k) = tbl(I, 5)
                Arr(5, k) = tbl(I, 6)
                Arr(6, k) = tbl(I, 7)
                Arr(7, k) = tbl(I, 8) & ", " & tbl(I, 9)
                Arr(8, k) = tbl(I, 10)
                For Q = 11 To 20
                    If UCase(tbl(I, Q)) = "X" Then
                        If ListeCompetence = "" Then
                            ListeCompetence = tbl(1, Q)
                        Else
                            ListeCompetence = ListeCompetence & ";" & tbl(1, Q)
                        End If
                    End If
                Next Q
                Arr(9, k) = ListeCompetence
                Arr(10, k) = "X"
                Arr(11, k) = tbl(I, 21)
                Arr(12, k) = CLng(tbl(1, J))
                Arr(13, k) = tbl(I, J)
                k = k + 1
            End If
        Next J
    Next I
Il faut ajouter la déclaration
Dim ListeCompetence$
Par contre, je n'ai pas compris à quoi servait la colonne k (valeur) dans table2, j'ai mis "X" par défaut.

Jers
m
matimatfr
Membre habitué
Membre habitué
Messages : 73
Appréciations reçues : 3
Inscrit le : 14 novembre 2016
Version d'Excel : 2010 FR

Message par matimatfr » 8 janvier 2020, 09:55

Merci pour ta proposition Jers, même si celle-ci ne me fait pas aboutir à ce que je recherche, elle m'a donné des pistes de réflexion.

Pour répondre à ta question, la colonne valeurs dans la table en exemple, celle-ci me sort les résultats si la compétence est acquise ou non (les X dans les lignes du Planning).

En adaptant un peu à partir de ce que tu proposes, j'arrive à une partie du résultat voulu en mettant ce code :
Public Sub Create_Table2()
Dim wb As Workbook
Dim wsData As Worksheet, wsTable As Worksheet
Dim lo As ListObject
Dim Cell As Range
Dim tbl, Arr()
Dim I As Long, J As Long, k As Long, Q As Long

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("PLANNING 2020B")
    Set wsTable = wb.Worksheets("Table2")
    Set lo = wsTable.ListObjects(1)

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set Cell = .InsertRowRange.Cells(1)
    End With

    tbl = wsData.Cells(1).CurrentRegion.Value
      For I = 2 To UBound(tbl)
        For J = 22 To UBound(tbl, 2)
            If tbl(I, J) <> "" Then
                ReDim Preserve Arr(13, k + 1)
                Arr(0, k) = tbl(I, 1)
                Arr(1, k) = tbl(I, 2)
                Arr(2, k) = tbl(I, 3)
                Arr(3, k) = tbl(I, 4)
                Arr(4, k) = tbl(I, 5)
                Arr(5, k) = tbl(I, 6)
                Arr(6, k) = tbl(I, 7)
                Arr(7, k) = tbl(I, 8) & ", " & tbl(I, 9)
                Arr(8, k) = tbl(I, 10)
                For Q = 11 To 20
                  Arr(9, k) = tbl(1, Q)
                  Arr(10, k) = tbl(I, Q)
                Next Q
                Arr(11, k) = tbl(I, 21)
                Arr(12, k) = CLng(tbl(1, J))
                Arr(13, k) = tbl(I, J)
                k = k + 1
            
            End If
        Next J
    Next I

    If k > 0 Then Cell.Resize(k, 14).Value = Application.Transpose(Arr)
    lo.HeaderRowRange.EntireColumn.AutoFit

End Sub
Néanmoins, un soucis, en entrant le code comme ça, ça me sort uniquement les résultats de la colonne 20, et manque au final les résultats des colonnes 11 à 19, comme s'il ne bouclait pas sur le tout....
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 305
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 8 janvier 2020, 13:11

Ca cest normal car tu boucles de 11 à 20 mais avec la même valeur de k, donc il ne garde que la dernière à savoir 20.
Par contre. Peux tu m'expliquer pourquoi ma proposition ne convient pas. Tu veux faire une ligne par compétence ?
m
matimatfr
Membre habitué
Membre habitué
Messages : 73
Appréciations reçues : 3
Inscrit le : 14 novembre 2016
Version d'Excel : 2010 FR

Message par matimatfr » 8 janvier 2020, 13:35

Ce n'est pas que la solution ne convient pas (terme un peu fort :wink: ), elle n'aboutit pas (encore ? :) )au résultat attendu. En effet, j'aimerai une compétence par ligne, comme le montre la copie d'écran ci-dessous pour le résultat avec ma boucle sans k et pour laquelle je metire les cheveux depuis ton message...
résultats excel pratique.JPG
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 305
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 8 janvier 2020, 16:03

Donc si pour une ligne dans planning2020b tu as 5 compétences et 5 dates, tu veux 10 lignes dans table 2 ? Si oui pas de pb je te l'envoie ce soir
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message