Incrémentation Num selon critères - VBA
Bonjour,
Je cherche à attribuer automatiquement des numéros de fiches selon plusieurs critères :
- Nom de l'agent
- Numéro de la semaine
Exemple :
David saisi des données le 01/01/19 -> N° de fiche attribué : David /S-1/N-1
Estelle saisi des données le 01/01/19 -> N° de fiche attribué: Estelle /S-1/N-1
David saisi des données le 02/01/19 -> N° de fiche attribué : David /S-1/N-2
Estelle saisi des données le 03/01/19 -> N° de fiche : Estelle /S-1/N-2
Estelle saisi des données le 03/01/19 -> N° de fiche : Estelle /S-1/N-3
David saisi des données le 01/01/19 -> N° de fiche : David /S-1/N-3
Quelqu'un pourrait-il m'aider, SVP?
Bonjour,
à essayer :
en B3 : =E3&"/"&" S-"&C3&" /N-" &NB.SI($E$3:E3;E3)
puis tirer vers le bas
A+
Bonjour,
Merci pour ton aide
J'essaie de mettre cette formule dans mon code vba, mais j'obtiens une erreur de compilation :
Sheets(ShG).Range("B14") =Sheets(ShS).Range("D2")&"/"&" S-"&Sheets(ShS).Range("B2)&" /N-" &NB.SI($D$2:D2;D2)
Code complet :
Const ShG = "Guide"
Const ShS = "Sauvegarde"
Public Ligne As Long
Sub Archiver_OK()
Dim i As Integer
Application.ScreenUpdating = False
With Worksheets(ShG)
Call controles
Select Case .Range("B6").Value
Case Is = "ERREUR(S) DETECTEE(S)"
Call Sauve
Sheets(ShS).Range("N" & Ligne) = .Range("B6").Value
For i = 13 To .Range("E" & .Rows.Count).End(xlUp).Row
If .Range("E" & i).Value <> "" Then
If .Range("E" & i).Value = "Donnée Non Saisie" Or .Range("E" & i).Value = "Saisie Erronée" Then
Call Sauve
Sheets(ShG).Range("D" & i & ":F" & i).Copy
Sheets(ShS).Range("K" & Ligne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
End If
End If
Next i
Application.CutCopyMode = False
Case Is = "PAS D'ERREURS DETECTEES"
Call Sauve
Sheets(ShS).Range("N" & Ligne) = .Range("B6").Value
End Select
End With
Sheets(ShG).Range("B14") =Sheets(ShS).Range("D2")&"/"&" S-"&Sheets(ShS).Range("B2)&" /N-" &NB.SI($D$2:D2;D2)
'Sheets(ShS).Range("A" & Ligne).Value
'Sheets(ShG).Range("B18").Value & "/ S-" & Sheets(ShG).Range("B16").Value & "/" & "N-" & Sheets(ShG).Range("B14") + 1 'N° Fiche
'.Range("B14") + 1
Call Imprimer
Call RAZ
Application.ScreenUpdating = True
End Sub
Sub controles()
With Worksheets(ShG)
'controle du remplissage des Num Adh / Date de réception / Date de traitement / Dossier traité par / Acte de gestion / Contrôleur / Date du contrôle / N° Fiche
If .Range("B18") = "" Or .Range("B23") = "" Or .Range("B27") = "" Or .Range("B29") = "" Or .Range("B31") = "" Or .Range("B33") = "" Then MsgBox "Les champs suivants doivent être complétés :" & vbNewLine & " - Le N° Adhérent" & vbNewLine & " - Les dates de réception et de traitement du dossier" & vbNewLine & " - Le Prénom du Gestionnaire ayant traité le dossier" & vbNewLine & " - L'acte de gestion" & vbNewLine & " - Le prénom du Contrôleur et la date du contrôle": End
'Controle de La date de traitement du dossier
If .Range("B29").Value > .Range("B31").Value Then MsgBox "La date de traitement du dossier doit être postérieure ou égale à sa date de réception": End
'Controle du nom du controleur et responsable du dossier
If .Range("B33").Value = .Range("B18").Value Then MsgBox "Le Contrôleur " & Range("B18") & " doit être différent du Gestionnaire ayant traité le dossier": End
'Controle de la date du controle par rapport aux dates de réception ou de traitement du dossier
If .Range("B20").Value < .Range("B29").Value Or .Range("B20").Value < .Range("B31").Value Then MsgBox "La date du contrôle doit être postérieure ou égale aux dates de réception et de traitement du dossier": End
'Controle de la présence de tous les résultats en colonne D et E
If WorksheetFunction.CountIf(.Range("D13:D31"), ">*") <> WorksheetFunction.CountIf(.Range("E13:E31"), ">*") Then MsgBox "Le résultat de chaque Point de Contrôle doit être renseigné ! ": End
End With
End Sub
Sub Sauve()
Ligne = Sheets(ShS).Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With Sheets(ShG)
'Sheets(ShS).Range("A" & Ligne).Value = .Range("B18").Value & "/ S-" & .Range("B16").Value & "/" & "N-" & .Range("B14").Value 'N° Fiche
Sheets(ShS).Range("B" & Ligne).Value = .Range("B16").Value 'N° SEMAINE
Sheets(ShS).Range("C" & Ligne).Value = .Range("B20").Value 'Date du contrôle
Sheets(ShS).Range("D" & Ligne).Value = .Range("B18").Value 'Contrôleur
Sheets(ShS).Range("E" & Ligne).Value = .Range("B23").Value 'Type
Sheets(ShS).Range("F" & Ligne).Value = .Range("B27").Value 'Num CL
Sheets(ShS).Range("G" & Ligne).Value = .Range("B29").Value 'Date de réception
Sheets(ShS).Range("H" & Ligne).Value = .Range("B31").Value 'Date de traitement
Sheets(ShS).Range("I" & Ligne).Value = .Range("B33").Value 'Traité par
End With
MsgBox "Le transfert a été exécuté avec succès !"
End Sub
Aaah ! désolé; moi qui suis plus à l'aise avec VBA, j'ai proposé une formule Excel ....