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 ....