Colonne A par double clic sur une plage de la feuille, j'ai des doublons
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Bonjour toutes et tous
bon j'ai toujours ce problème sur la colonne A pour les doublons
Edit 31/12/2020 : Merci @ Ric code corrigé également ci-dessous sur les doublons et le chrono suite à la nouvelle version
crdlt,
André
la grille B5 a K14, lorsque j'effectue un clic sur la grille
sur la feuil2 : Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
bug sur la dernière ligne après la cellulule B14* qui quant à cette cellule si double-cliquer n'est pas comptabiliser et la valeur 0ne s'ajoute pas dans la colonne A de la feuille (çà c'est ok) mais lorsque, je dépasse de C14 à K14 les doublons s'affichent dans la colonne A, j'ai regardé sur le code :
'Dim DL As Integer
'Dim cell As Object
'If Not Intersect(Target, Range("B5:K13")) Is Nothing Then
' Cancel = True 'annule effet double-clic
' DL = Cells(Rows.Count, 1).End(xlUp).Row
' Range("A" & DL + 1) = Target.Value
'
' For Each cell In Range("B5:K13")
' Range("G3").Value = ActiveCell.Value
' Next cell
' Cancel = True
'End If
' ##################################################################
' ------------------------------------------------------------ 29122020
If Not Intersect(Target, [B5:k13]) Is Nothing Then
Cancel = 1
If [A2] = "" Then [A2] = Target
If Application.CountIf([A:A], Target) = 0 Then Cells(Rows.Count, 1).End(xlUp)(2) = Target.Value
Range("G3").Value = ActiveCell.Value
' on rend la couleur de fond jaune
If Target.Interior.ColorIndex = 6 Then Target.Interior.ColorIndex = 2
End If
' ##################################################################
'---------------------------------------------------------
' --------------Ordonc à voir si
'Dim R As Range
' If Not Intersect(R, [B5:k14]) Is Nothing Then
' Cancel = 1
' If [A1] = "" Then [A1] = R
' If Application.CountIf([A:A], R) = 0 Then Cells(Rows.Count, 1).End(xlUp)(2) = R.Value
' ' Range("G3").Value = ActiveCell.Value
' End If
'------------------------------------------------------
' ##################################################################
Dim DL1 As Integer
If Not Intersect(Target, Range("C14:K14")) Is Nothing Then
Cancel = True 'annule effet double-clic
DL1 = Cells(Rows.Count, 1).End(xlUp).Row
Range("A" & DL1 + 1) = Target.Value
''' Range("A" & DL1 + 1) = Target.Value
Dim cell1 As Object
For Each cell1 In Range("B5:K13")
Range("G3").Value = ActiveCell.Value
Next cell1
Cancel = True
End If
aussi non, j'ai un peu avancé
Modifications et ajouts effectuées version 5.f :
- affichage de message aléatoire
- un petit chrono (stop, reset etc.)
ci-joint: v5.f
crdlt,
André