Selectionchange sur plusieurs colonnes et gestion doublons

Bonjour tout le monde,

j'ai glissé un code un peu lourd et qui ne fonctionne pas vraiment

Avec celui-ci je souhaite remplir la feuille "convocations" dès que je rentre des valeurs dans les colonnes L, M, N de la feuille "data"

Cela fonctionnait lorsque j'avais 1 seule colonne qui était modifiable et que je passais par un array() seulement maintenant il y en a 3 qui peuvent être modifiées, je voudrais donc en parrallèle gérer les doublons et m'assurer que si les cellules ont déjà été importées et que je modifie une des 3 colonnes, il faudrait supprimer la ligne déjà renseignée et rajouter la nouvelle ligne ou simplement rajouter la cellule modifiée au bon emplacement.

La gestion des doublons se ferait sur les cellules des colonnes 1, 11 et 2 de la feuille "data" et 1,2,3 de la feuille "convocations" respectivements.

Le fichier en version exemple

Merci d'avance pour vos bons conseils

Option Explicit
Dim Continuer1 As Integer, Continuer2 As Integer
Dim MaLigne As Long
Dim FL1 As Worksheet, FL2 As Worksheet, FL3 As Worksheet
Dim SHT1 As String, SHT2 As String, SHT3 As String
Dim TBL1 As String, TBL2 As String
Dim ValCell As Variant
Dim cell As Range, trouveC1 As Range, trouveC2 As Range, trouveL As Range
Dim PlageR1 As Range, PlageR2 As Range, PlageR3 As Range
Dim Vcc1 As String, Vcc2 As String, Vcc3 As String, At1 As String, At2 As String, At3 As String
Dim DerL%

Private Sub Worksheet_Change(ByVal Target As Range)

SHT1 = "Data"
SHT2 = "Planning"
SHT3 = "Convocations"
TBL1 = "A1"
TBL2 = "B5"

Set FL1 = Worksheets(SHT1)
Set FL2 = Worksheets(SHT2)
Set FL3 = Worksheets(SHT3)

MaLigne = FL3.UsedRange.Resize(, 2).Find("*", , , , xlRows, xlPrevious).Row + 1
DerL = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
FL1.Columns(12).NumberFormat = "dd/mm/yy;@"
FL2.Range(TBL2).CurrentRegion.Offset(1, 1).NumberFormat = "dd/mm/yy;@"

If Target.Count > 1 Then
Exit Sub
End If

' On active la macro si une cellule est modifiée
If Not Application.Intersect(Target, Range("L2:L" & DerL)) Is Nothing _
Or Not Application.Intersect(Target, Range("M2:M" & DerL)) Is Nothing _
Or Not Application.Intersect(Target, Range("N2:N" & DerL)) Is Nothing Then
Continuer1 = MsgBox("Êtes-vous certain de vouloir convoquer à cette date/heure?", vbYesNo + vbExclamation + vbDefaultButton2)
Application.EnableEvents = False
Target.NumberFormat = "dd/mm/yy;@"
Application.EnableEvents = True
Else
Exit Sub
End If

Application.EnableEvents = False
With FL3
' calcul de la première ligne vide sur les 4 colonnes
MaLigne = .UsedRange.Resize(, 15).Find("*", , , , xlRows, xlPrevious).Row + 1

    ' si on ne continue pas
    If Continuer1 = vbNo Then
    Target.Value = ValCell
    ' si on continue
    Else

        If Cells(Target.Row, 6).Value = "" And _
        Cells(Target.Row, 7).Value = "" And _
        Cells(Target.Row, 8).Value = "" And _
        Cells(Target.Row, 9).Value = "" And _
        Cells(Target.Row, 10).Value = "" Then
        MsgBox ("il n'y a pas de convocation à envoyer pour l'opération " & Cells(Target.Row, 2).Value & " de l'équipement " & Cells(Target.Row, 12).Value)
        Target.Value = ValCell
        Else

            'on cherche les dates de début d'opération du planning par équipement
            'affectation de valeurs aux variables :
            Vcc1 = FL1.Cells(Target.Row, 2).Value
            Vcc2 = "debut"
            Vcc3 = FL1.Cells(Target.Row, 11).Value

            'On définit les différentes plages de recherches
            Set PlageR1 = FL2.Rows(4)
            Set PlageR2 = FL2.Rows(5)
            Set PlageR3 = FL2.Columns(2)

            '*******************************

            'On cherche la valeur exacte (LookAt:=xlWhole)
            Set trouveC1 = PlageR1.Cells.Find(what:=Vcc1, LookAt:=xlWhole)
            If Not trouveC1 Is Nothing Then
            Set trouveC2 = PlageR2.Cells.Find(what:=Vcc2, LookAt:=xlWhole)
                If Not trouveC2 Is Nothing Then
                    Set trouveL = PlageR3.Cells.Find(what:=Vcc3, LookAt:=xlWhole)
                    If Not trouveL Is Nothing Then

            'On enregistre les valeurs
            At1 = trouveC1.Address
            At2 = trouveC2.Address
            At3 = trouveL.Address

                    End If
                End If
            End If

            'On compare avec la date saisie
            If Target <> FL2.Cells(Range(At3).Row, Range(At1).Column).Value Then
            Continuer2 = MsgBox("Vous allez convoquer à une date différente du début d'opération" & "(" & FL2.Cells(Range(At3).Row, Range(At1).Column).Value & ")", vbYesNo + vbExclamation + vbDefaultButton2)
                If Continuer2 = vbNo Then
                Target.Value = ValCell
                Else

                ' on injecte les 15 valeurs directement en passant un tableau
                Worksheets("convocations").Cells(MaLigne, 1).Resize(1, 15).Value = _
                Array("", Cells(Target.Row, 1).Value, _
                Cells(Target.Row, 11).Value, _
                Cells(Target.Row, 2).Value, _
                Cells(Target.Row, 4).Value, "", _
                Cells(Target.Row, 5).Value, _
                Cells(Target.Row, 8).Value, _
                Cells(Target.Row, 9).Value, _
                Cells(Target.Row, 10).Value, _
                Cells(Target.Row, 12).Value, _
                Cells(Target.Row, 13).Value, _
                Cells(Target.Row, 14).Value, _
                Cells(Target.Row, 15).Value, _
                Cells(Target.Row, 16).Value)

                End If
            End If
        End If
    End If
Set PlageR1 = Nothing
Set PlageR2 = Nothing
Set PlageR3 = Nothing
Set trouveC1 = Nothing
Set trouveC2 = Nothing
Set trouveL = Nothing
Application.EnableEvents = True
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
DerL = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
If Target.Count > 1 Then
Exit Sub
End If
If Not Application.Intersect(Target, Range("L2:L" & DerL)) Is Nothing Then
ValCell = Target
End If
End Sub
15convocexemple1.zip (46.62 Ko)
Rechercher des sujets similaires à "selectionchange colonnes gestion doublons"