Mise à jour tableau code VBA

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

5fichier-test.xlsm (23.32 Ko)

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

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.

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

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"

6fichier-test.xlsm (37.94 Ko)

Un grand merci pour votre aide,

Cordialement

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 ?

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.

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

Rechercher des sujets similaires à "mise jour tableau code vba"