Index Equiv dans Macro - réalisable
ok, maintenant j'ai un soucis avec le personnel20
Bonsoir,
pas de souci avec la correction que je t'ai proposée. S'il ne trouve pas, c'est qu'il n'y est pas. Vérifie si le nom est bien écrit de la même façon y compris les blancs s'il y en a.
lol bien vu le mot souci.
Oui il est bien écrit (idem) dans les différents bulletins à consolider. Je l'ai même changer de place dans les bulletins pour voir un peu comment réagissait la Macro.
Bonsoir,
je ne parviens pas à reproduire ce problème que tu mentionnes. Peux-tu m'envoyer le bilan et le fichier qui pose problème (anonymisés)?
Je t’envoie ça de suite parce que je bidouille des trucs depuis tout à l’heure mais en vain
Voici donc l’ensemble des documents
Suivi_formation1 : document le plus utilisé où l'ont peut saisir un bulletin journalier - modifier la liste des personnels - se rendre sur le bilan annuel par un lien hypertexte.
BILAN 2019ok : document sur lequel j'ai copié ton code, qui va chercher dans un document que j'ai appelé FMA, qui contient tous les bulletins journaliers enregistré, et qui additionne toute les cellules en fonction du theme, de la spécialité et du personnel. Bien entendu sous la forme jj.mm.aaaa
17.06.2019 : exemple de bulletin.
Donc la chose qui pause problème et ce sur quoi j'étais en réflexion c'est que tous les bulletins enregistrés risques de ne pas avoir les mêmes personnels au même colonne.
Merci pour ton aide précieuse
@Riderpsy
Bonsoir,
il y avait bien encore un bug. J'espère que ce sera le dernier cette fois.
voici une version corrigée
Sub aargh()
Set twb = ThisWorkbook
With Application.FileDialog(msoFileDialogFolderPicker) 'choix du répertoire
.AllowMultiSelect = False
.Title = "Choisir le répertoire contenant les fichiers à consolider"
If .Show = True Then
rep = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
anac = Val(InputBox("année à consolider")) 'choix de l'année à consolider
If Len(anac) < 4 Then anac = 2000 + anac
If anac = 0 Then Exit Sub
nf = rep & "*.*." & Format(anac, "0000") & ".xls*"
nf = Dir(nf)
While nf <> "" 'on examine les fichiers de l'année qui ont le format *.*.année.xls*
Application.StatusBar = "consolidation fichier " & nf
Application.DisplayAlerts = False
Set wb = Workbooks.Open(rep & nf, UpdateLinks:=False) 'ouverture du fichier
Set ws = wb.Sheets("bulletin") 'selection du bulletin
Application.DisplayAlerts = True
dl = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To dl ' pour chaque ligne du bulletin
ns = ws.Cells(i, 1)
If ns = "" Then Exit For
Set wst = twb.Sheets(ns) 'on ouvre l'onglet correspondant à la spécialité
dlt = wst.Cells(4, 1).End(xlDown).Row
Set plagewst = wst.Range("A4:A" & dlt)
Set re = plagewst.Find(ws.Cells(i, 2), lookat:=xlWhole) 'on recherche la technique dans l'onglet de la spécialité
If re Is Nothing Then 'si pas trouvée on l'ajoute
wst.Rows(dlt).Copy
wst.Rows(dlt + 1).Insert Shift:=xlDown
dlt = dlt + 1
wst.Cells(dlt, 1) = ws.Cells(i, 2)
q = dlt
Else
q = re.Row
End If
dct = wst.Cells(3, Columns.Count).End(xlToLeft).Column
Set plagenom = Range(wst.Range("B3"), wst.Cells(3, dct))
dc = ws.Cells(i, Columns.Count).End(xlToLeft).Column
For j = 3 To dc 'on compte les personnes qui ont participé
If ws.Cells(i, j) <> "" Then
'recherche du nom dans l'onglet spécialité
Set re = plagenom.Find(ws.Cells(3, j), lookat:=xlWhole, LookIn:=xlValues)
If re Is Nothing Then
MsgBox "personnel " & ws.Cells(3, j) & " non trouvé dans l'onglet " & wst.Name
Else
wst.Cells(q, re.Column) = wst.Cells(q, re.Column) + 1
End If
End If
Next j
Next i
wb.Close
nf = Dir
Wend
Application.StatusBar = ""
End SubBonsoir,
il y avait bien encore un bug. J'espère que ce sera le dernier cette fois.
voici une version corrigée
Sub aargh() Set twb = ThisWorkbook With Application.FileDialog(msoFileDialogFolderPicker) 'choix du répertoire .AllowMultiSelect = False .Title = "Choisir le répertoire contenant les fichiers à consolider" If .Show = True Then rep = .SelectedItems(1) & "\" Else Exit Sub End If End With anac = Val(InputBox("année à consolider")) 'choix de l'année à consolider If Len(anac) < 4 Then anac = 2000 + anac If anac = 0 Then Exit Sub nf = rep & "*.*." & Format(anac, "0000") & ".xls*" nf = Dir(nf) While nf <> "" 'on examine les fichiers de l'année qui ont le format *.*.année.xls* Application.StatusBar = "consolidation fichier " & nf Application.DisplayAlerts = False Set wb = Workbooks.Open(rep & nf, UpdateLinks:=False) 'ouverture du fichier Set ws = wb.Sheets("bulletin") 'selection du bulletin Application.DisplayAlerts = True dl = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 4 To dl ' pour chaque ligne du bulletin ns = ws.Cells(i, 1) If ns = "" Then Exit For Set wst = twb.Sheets(ns) 'on ouvre l'onglet correspondant à la spécialité dlt = wst.Cells(4, 1).End(xlDown).Row Set plagewst = wst.Range("A4:A" & dlt) Set re = plagewst.Find(ws.Cells(i, 2), lookat:=xlWhole) 'on recherche la technique dans l'onglet de la spécialité If re Is Nothing Then 'si pas trouvée on l'ajoute wst.Rows(dlt).Copy wst.Rows(dlt + 1).Insert Shift:=xlDown dlt = dlt + 1 wst.Cells(dlt, 1) = ws.Cells(i, 2) q = dlt Else q = re.Row End If dct = wst.Cells(3, Columns.Count).End(xlToLeft).Column Set plagenom = Range(wst.Range("B3"), wst.Cells(3, dct)) dc = ws.Cells(i, Columns.Count).End(xlToLeft).Column For j = 3 To dc 'on compte les personnes qui ont participé If ws.Cells(i, j) <> "" Then 'recherche du nom dans l'onglet spécialité Set re = plagenom.Find(ws.Cells(3, j), lookat:=xlWhole, LookIn:=xlValues) If re Is Nothing Then MsgBox "personnel " & ws.Cells(3, j) & " non trouvé dans l'onglet " & wst.Name Else wst.Cells(q, re.Column) = wst.Cells(q, re.Column) + 1 End If End If Next j Next i wb.Close nf = Dir Wend Application.StatusBar = "" End Sub
Bonsoir le forum, bonsoir h2so4,
Un simple message pour te remercier pour ce code qui me sert tellement !!!!
Vive le VBA !