A voir également:
- Pb protection feuille avec une macro contrôle des doublons
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Supprimer les doublons excel - Guide
- Comment supprimer une feuille sur word - Guide
- Doublons photos - Guide
- Macro word - Guide
1 réponse
Bonjour,
Vous l'avez sans doute compris le code que j'avais joint dans mon précédent message n'était pas le bon (je les ai modifiés plusieurs fois pour essayer de trouver seul la solution !) Veuillez accepter mes excuses. Il faut dire que je ne suis pas un expert en excel...ni même en informatique d'ailleurs ! et je crois que mon apprentissage est loin de se terminer...enfin on y croit.
Dans la macro ci-après, on peut voir que la feuille est déprotégée systématiquement par le code mais a priori la macro ne fonctionne que si la feuille est déprotégée.
J'ai donc pensé que celà provenait du fait que dans mes colonnes J, W, AI j'avais également des cellules protégées, celles ci interdisant le contrôle des doublons. J'ai donc déprotégées toutes les cellules de ces colonnes et modifier la macro (suppression des lignes relatives à la déprotection). Sans résultat, j'ai des messages d'erreur qui me renvoient à la ligne:
If vCellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then.
Il ne me reste plus qu'à trouver la solution à ce problème pour finaliser mon projet, si vous pouviez m'aider, ce serait "top". Merci.
En attendant, je vous souhaite de passer une bonne, voire une excel(lente) journée.
GIBO35
Private Sub Worksheet_change(ByVal Target As Range)
Dim mdp As String
mdp=Sheets("feuil1").Range("A1").Value
ActiveSheet.Unprotect mdp
Dim vCol As Integer
Dim vRéponse As Integer
Dim vCellule As Object
If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
vCol = Target.Column
Dim val As String
val = ""
If vCol = 10 Then
val = "J:J"
ElseIf vCol = 23 Then
val = "W:W"
ElseIf vCol = 35 Then
val = "AI:AI"
Else
Exit Sub
End If
For Each vCellule In Range(val)
If LCase(vCellule.Value) = LCase(Target.Value) And vCellule.Address <> Target.Address Then
vRéponse = MsgBox("Ce concurrent figure déjà dans l'ordre d'arrivée." & Chr(10), vbOKOnly + vbCritical, "DOUBLON")
If vRéponse = vbOK Then
Range(Target.Address).Activate
'SendKeys "{F2}"
Target.Value = ""
End If
Exit Sub
End If
If vCellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then Exit Sub
Next
ActiveSheet.Protect mdp
Vous l'avez sans doute compris le code que j'avais joint dans mon précédent message n'était pas le bon (je les ai modifiés plusieurs fois pour essayer de trouver seul la solution !) Veuillez accepter mes excuses. Il faut dire que je ne suis pas un expert en excel...ni même en informatique d'ailleurs ! et je crois que mon apprentissage est loin de se terminer...enfin on y croit.
Dans la macro ci-après, on peut voir que la feuille est déprotégée systématiquement par le code mais a priori la macro ne fonctionne que si la feuille est déprotégée.
J'ai donc pensé que celà provenait du fait que dans mes colonnes J, W, AI j'avais également des cellules protégées, celles ci interdisant le contrôle des doublons. J'ai donc déprotégées toutes les cellules de ces colonnes et modifier la macro (suppression des lignes relatives à la déprotection). Sans résultat, j'ai des messages d'erreur qui me renvoient à la ligne:
If vCellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then.
Il ne me reste plus qu'à trouver la solution à ce problème pour finaliser mon projet, si vous pouviez m'aider, ce serait "top". Merci.
En attendant, je vous souhaite de passer une bonne, voire une excel(lente) journée.
GIBO35
Private Sub Worksheet_change(ByVal Target As Range)
Dim mdp As String
mdp=Sheets("feuil1").Range("A1").Value
ActiveSheet.Unprotect mdp
Dim vCol As Integer
Dim vRéponse As Integer
Dim vCellule As Object
If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
vCol = Target.Column
Dim val As String
val = ""
If vCol = 10 Then
val = "J:J"
ElseIf vCol = 23 Then
val = "W:W"
ElseIf vCol = 35 Then
val = "AI:AI"
Else
Exit Sub
End If
For Each vCellule In Range(val)
If LCase(vCellule.Value) = LCase(Target.Value) And vCellule.Address <> Target.Address Then
vRéponse = MsgBox("Ce concurrent figure déjà dans l'ordre d'arrivée." & Chr(10), vbOKOnly + vbCritical, "DOUBLON")
If vRéponse = vbOK Then
Range(Target.Address).Activate
'SendKeys "{F2}"
Target.Value = ""
End If
Exit Sub
End If
If vCellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then Exit Sub
Next
ActiveSheet.Protect mdp