Je cherche un moyen d'empêcher un utilisateur d'ajouter une entrée en double dans une colonne Excel. J'ai trouvé le moyen de définir la colonne dans Excel, mais cela ne fonctionne pas avec l'entrée userform.

J'ai essayé le paramètre de validation des données dans Excel et ils fonctionnent, mais lorsque l'entrée provient de la forme utilisateur, ils ne le font pas.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strTargetColumn As String
    Dim nTargetRow As Integer
    Dim nLastRow As Integer
    Dim strMsg As String

    strTargetColumn = Split(Target.Address(, False), "$")(0)
    nTargetRow = Split(Target.Address(, False), "$")(1)
    nLastRow = ActiveSheet.Range(strTargetColumn & ActiveSheet.Rows.Count).End(xlUp).Row

    For nRow = 1 To nLastRow
        If nRow <> nTargetRow Then
          If ActiveSheet.Range(strTargetColumn & nRow).Value = Target.Value Then
             strMsg = "The value has been entered in the same column!"
             MsgBox strMsg, vbExclamation + vbOKOnly, "Duplicate Values"
             Target.Select
             Exit For
          End If
       End If
    Next

End Sub

Il s'agit d'un code que j'ai trouvé lors d'une recherche sur le Web qui apparaît qu'un doublon a été entré dans la colonne mais lui permet toujours de rester dans la colonne.

Je voudrais qu'un popup indique à l'utilisateur qu'il a ajouté un doublon et ne lui permette pas d'entrer dans la cellule. Est-ce possible?

Userform

0
Malachilee 4 nov. 2019 à 15:58

1 réponse

Regardez-le dans l'événement Click du formulaire utilisateur pour vos boutons. Vous trouverez ci-dessous un moyen de le faire pour le bouton Géométrie. Vous devez toujours utiliser Option Explicit pour forcer la déclaration de variable; votre code implique que vous ne le faites pas. Soyez explicite avec vos objets - n'utilisez pas ActiveWorkbook, ActiveCell, etc.

Il existe de nombreuses façons d'améliorer cela. Ce n'est pas vraiment une bonne façon de procéder. Je vous fournis ceci pour vous permettre d'aller sur une meilleure piste.

'@Folder("VBAProject")
Option Explicit

Private Sub GeometryAddButton_Click()
    Dim theValueToAdd As Double
    theValueToAdd = CDbl(Me.theGeometryTextbox.Text) 'assumes the value is a double
    Dim theTargetWorkbook As Workbook
    Set theTargetWorkbook = ThisWorkbook 'assumes you want to use the book the form and code are in
    Dim theTargetWorksheet As Worksheet
    Set theTargetWorksheet = theTargetWorkbook.Worksheets("myDatabaseWorksheet") 'whatever teh name of your worksheet actually is
    With theTargetWorksheet
        Dim theGeometryColumn As Long
        theGeometryColumn = 1 'assumes the Geometry column is Column A (i.e. 1)
        Dim GeometryDataRange As Range
        Set GeometryDataRange = .Range(.Cells(1, theGeometryColumn), .Cells(.UsedRange.Rows.Count, theGeometryColumn)) 'the full range of cells in Geometry column
    End With
    Dim findExistingValue As Range
    Set findExistingValue = Nothing
    On Error Resume Next 'if the value isn't found the Find method will fail, but that is what we are going to test for
        Set findExistingValue = GeometryDataRange.Find(theValueToAdd, LookIn:=xlValues, lookat:=xlWhole)
    On Error GoTo 0
    If Not findExistingValue Is Nothing Then 'if the Find does not fail (i.e. findExistingValue is not nothing)
        'pop up the message that the value already exists
    Else
        'add the value to the list
    End If
End Sub
0
SmileyFtW 4 nov. 2019 à 17:16