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?
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