Nananinanana
XLDnaute Nouveau
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
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
Code:
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
Dim At1 As String, At2 As String, At3 As String
Dim DerL%, DerL2%
Dim i As Integer
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)
DerL = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
DerL2 = Worksheets("convocations").Cells(Rows.Count, 2).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
'On vérifie s'il y a bien une convocation à envoyer
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 avec la date du planning
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
For i = 29 To DerL2
If Not Sheets("Convocations").Cells(i, 2).Cells.Find(what:=Cells(Target.Row, 1).Value, LookAt:=xlWhole) Is Nothing _
And Not Sheets("Convocations").Cells(i, 3).Cells.Find(what:=Cells(Target.Row, 11).Value, LookAt:=xlWhole) Is Nothing _
And Not Sheets("Convocations").Cells(i, 4).Cells.Find(what:=Cells(Target.Row, 2).Value, LookAt:=xlWhole) Is Nothing Then
Sheets("Convocations").Cells(i, 4).EntireRow.Delete
End If
Next
' 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
On Error Resume Next
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
ValCell = Target
End If
End Sub