Colonne A par double clic sur une plage de la feuille, j'ai des doublons

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é

Rechercher des sujets similaires à "colonne double clic plage feuille doublons"