mise à jour tableau code VBA

Y compris Power BI, Power Query et toute autre question en lien avec Excel
F
Fanini_excel
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 4 décembre 2018
Version d'Excel : 2013

Message par Fanini_excel » 11 février 2019, 10:46

Bonjour à tous,

J'aimerai à partir d'une base de donnée mettre à jour un tableau en fonction des noms des collaborateurs et de leur compétences.
Le but pour un collaborateur nommé "DUPONT" avec une compétence A et une compétences B, voir apparaître ces compétences sur une autre feuille excel en positionnant une croix dans un tableau récapitulatif. J'ai commencé à écrire un code VBA mais je bloque vers la fin (notamment pour mettre la croix dans le tableau). Pouvez-vous m'aider ?
Sub job() 'mise à jour des compétences des collaborateurs'

   
    Dim debut As Date, Fin As Date  'déclaration les variables de façon explicite'
    Dim nblig As Long, i As Long, j As Long, k As Long, nom As String, job As String, competences As String
    Dim result As Range
      
    
     Application.ScreenUpdating = False
     
    
          
     Dim jreport As Worksheet
     
     Set jreport = Sheets("report_skills") 'attribution de la variable du worksheet'
     
     Dim fjob As Worksheet
     
      Set fjob = Sheets("Fichier") 'attribution de la variable'
      
      fcp.Activate ' activation de la feuille fcp'
            
      [B8:G13].ClearContents 'suppresion du tableau des competences'
      
           
        
      nbLignes = jreport.[A1].CurrentRegion.Rows.Count 'comptage du nombre de ligne du tableau des compétences'
      
      For i = 2 To nblig
      
        nom = jreport.Cells(i, 1) 'attribution variable nom'
        
        For j = 2 To nblig
        
              job = jreport.Cells(i, 2) 'attribution de la variable job'
              
        For k = 2 To 7
                         
        
        Set result = fcp.Range("A8:A13").Find(What:=nom, LookIn:=xlValues) 'comparaison entre les noms de la base de donnée et les noms de l'équipe'
        
                
        If Not result Is Nothing Then
        
         
           jreport.Cells(i, j) = fcp.Cells(7, k) 'comparaison des compétences entre les deux tableaux'
           
            'mettre une croix dans le tableau par compétence'
            
            
               
                 
                 
         
                    End With
          End If
       End If
    Next i
    Next j
     
 
End Sub
Merci beaucoup pour votre aide
Fichier_test.xlsm
(23.32 Kio) Téléchargé 4 fois
Avatar du membre
Dan
Modérateur
Modérateur
Messages : 5'787
Appréciations reçues : 72
Inscrit le : 27 avril 2007
Version d'Excel : 2010, 2000, Mac 2004, 2011

Message par Dan » 11 février 2019, 13:27

Bonjour

Essayez avec ce code
Sub test()
Dim lig As Byte, col As Byte
Dim i As Integer
Sheets("Fichier").Range("B8:G13").ClearContents
With Sheets("report_skills")
    For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
        On Error Resume Next
        lig = WorksheetFunction.Match(.Range("A" & i), Sheets("Fichier").Range("A:A").EntireColumn, 0)
        col = WorksheetFunction.Match(.Range("B" & i), Sheets("Fichier").Rows("7:7"), 0)
        If lig > 0 And col > 0 Then Sheets("Fichier").Cells(lig, col) = "X"
    Next
End With
End Sub
Si vous avez plus de 256 lignes dans votre feuille Fichier, changez la variable Dim lig as byte --> Dim lig as integer
Cordialement
@+ Dan ;)
F
Fanini_excel
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 4 décembre 2018
Version d'Excel : 2013

Message par Fanini_excel » 11 février 2019, 14:18

Merci Dan, ça fonctionne!
Par contre quand nous avons une grande base de donnée, le fichier Excel est long pour mettre à jour le tableau :)
As-tu une astuce?

Merci beaucoup pour ton aide.
Avatar du membre
Dan
Modérateur
Modérateur
Messages : 5'787
Appréciations reçues : 72
Inscrit le : 27 avril 2007
Version d'Excel : 2010, 2000, Mac 2004, 2011

Message par Dan » 12 février 2019, 08:06

Bonjour

Pouvez-vous me donner votre fichier ou tout au moins un fichier avec plus de données. Cela me permettra de voir comment il est structuré

Cordialement
@+ Dan ;)
F
Fanini_excel
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 4 décembre 2018
Version d'Excel : 2013

Message par Fanini_excel » 12 février 2019, 09:47

Bonjour Dan,

Je vous envoie le fichier avec plus de données. Je pense que le code est long car il y a d'autres tableaux sur la feuille "Fichier"
Fichier_test.xlsm
(37.94 Kio) Téléchargé 3 fois
Un grand merci pour votre aide,
Cordialement
Avatar du membre
Dan
Modérateur
Modérateur
Messages : 5'787
Appréciations reçues : 72
Inscrit le : 27 avril 2007
Version d'Excel : 2010, 2000, Mac 2004, 2011

Message par Dan » 12 février 2019, 12:55

Re

Un premier problème est que certaines cellules sont liées à un autre fichier. Normal cela ?

Est-ce que les tableaux situés entre la colonne A et G
- comporte toujours 6 personnes ?
- sont-ils chacun identiques ?

Combien de tableaux à compléter de X pouvez-vous avoir ?
@+ Dan ;)
F
Fanini_excel
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 4 décembre 2018
Version d'Excel : 2013

Message par Fanini_excel » 12 février 2019, 13:57

Bonjour Dan,

J'ai fait des copier-coller de mon fichier donc il y a certaines cellules qui sont liées à un autre fichier. Oups

Les tableaux situés entre la colonne A et G ne sont pas tous identiques car ils peuvent comporter plus de 6 personnes. Par contre au niveau des compétences "A", "B", "C" etc, il ne peut pas en avoir plus cela s'arrête à "F"
Je peux avoir jusqu'à 25 tableaux avec des X à compléter.
Je pense qu'il faudrait avoir un code qui tourne seulement jusqu'à la colonne G ?

Si besoin, je peux vous donner plus de détails

Merci beaucoup
F.
Avatar du membre
Dan
Modérateur
Modérateur
Messages : 5'787
Appréciations reçues : 72
Inscrit le : 27 avril 2007
Version d'Excel : 2010, 2000, Mac 2004, 2011

Message par Dan » 13 février 2019, 13:23

Bonjour

Combien pouvez-vous avoir de lignes dans la feuille report_skill ?

Essayez déjà avec ce code
Sub test()
Dim lig As integer, i As Integer
Dim col As Byte
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
With Sheets("Fichier")
    .Range("B5:G" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
End With
With Sheets("report_skills")
    For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
        On Error Resume Next
        lig = WorksheetFunction.Match(.Range("A" & i), Sheets("Fichier").Range("A:A").EntireColumn, 0)
        col = WorksheetFunction.Match(.Range("B" & i), Sheets("Fichier").Rows("4:4"), 0)
        If lig > 0 And col > 0 Then Sheets("Fichier").Cells(lig, col) = "X"
    Next
End With
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub
Cordialement
@+ Dan ;)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message