Vous pouvez simplement vérifier l'existence de votre chaîne de texte saisie par vba par défaut dans une cellule de la colonne ciblée chaque fois que l'utilisateur modifie le contenu d'une cellule de la feuille de calcul et si elle est trouvée, alerte l'utilisateur ou déplace ce qu'il a entré dans la cellule où il aurait dû être entré (les deux actions sont dans le code ci-dessous, (l'option Déplacer est commentée dans le bloc IF ELSE)):
Const USER_ENTRY_COL = 2 'Column users should be entering data into
Const TARGET_TEXT = "Enter your name here" 'The default text the VBA code uses to mark the correct cell
Const ENTRY_ROW_NOT_FOUND = -1 'Return value for correct cell search if correct cell cannot be found
Private Sub Worksheet_Change(ByVal Target As Range)
'do not test if not in user entry column
If Target.Column <> USER_ENTRY_COL Then Exit Sub
'do nothing if first cell of target range is empty or is target text,
'which it would be if macro is flagging cell for user
If Target.Cells(1, 1).Value = "" Or Target.Cells(1, 1).Value = TARGET_TEXT Then Exit Sub
Dim rowWithDefaultText As Long
rowWithDefaultText = find_row_with_default_text(USER_ENTRY_COL)
If rowWithDefaultText = ENTRY_ROW_NOT_FOUND Then
'user has overwitten the vba inserted default text,meaning they entered in the right row
Else
'Alerts the user and clears what they entered into the wrong cell
MsgBox "Please enter your information into row " & rowWithDefaultText, vbInformation, "Data Entered in Wrong Row"
Target.Clear
Cells(rowWithDefaultText, USER_ENTRY_COL).Activate
'' 'Moves whatever the user entered, from the wrong cell into the right cell
'' Dim name As Variant
'' name = Target.Cells(1, 1).Value
'' Target.Clear
'' Cells(rowWithDefaultText, USER_ENTRY_COL).Value = name
End If
End Sub
'//Finds the correct row that is meant to be used for user entry
'@PARAM colNum - The column number for the column to be searched
Private Function find_row_with_default_text(colNum As Integer) As Long
Dim CorrectEntryRow As Long
CorrectEntryRow = find_first_instance_row(TARGET_TEXT, USER_ENTRY_COL, 1, 500)
find_row_with_default_text = CorrectEntryRow
End Function
'//Cannot be found in the range, then a row value of '-1' will be returned
'@PARAM searchTerm - The value to find the first instance of
'@PARAM colNum - The column number for the column to be searched
'@PARAM startRow - The row number for the top of the range to be searched
'@PARAM endAtRow - The row number for the end of the range to be searched
Public Function find_first_instance_row(ByVal searchterm As String, _
ByVal colNum As Integer, ByVal startAtRow As Long, _
ByVal endAtRow As Long) As Long
Dim searchRange As Range
Set searchRange = Range(Cells(startAtRow, colNum), Cells(endAtRow, colNum))
Dim foundIt As Range
Set foundIt = searchRange.Find(searchterm, , , xlWhole)
If Not foundIt Is Nothing Then
find_first_instance_row = foundIt.Row
Else
'force bad value when not found this makes returned value easily testable
find_first_instance_row = -1
End If
Set searchRange = Nothing
Set foundIt = Nothing
End Function
Ce qui précède suppose que le texte inséré par vba était présent avant que l'utilisateur n'entre son nom; si, pour une raison quelconque, ce n'était pas le cas, il n'y a pas de test pour s'assurer que l'utilisateur n'a pas entré son nom à 2,3 ou 10 lignes. Si vous souhaitez ajouter un test à ce cas, le paramètre IF ELSE peut être modifié pour ressembler à quelque chose comme:
If rowWithDefaultText = ENTRY_ROW_NOT_FOUND Then
'user has overwitten that text in the cell that had the text prior
'Secondary check added
If Not entry_row_and_correct_row_match(USER_ENTRY_COL, 1, Target.Row) Then
MsgBox "Do Something Here to handle this case"
End If
Else
'Alerts the user and clears what they entered into the wrong cell
MsgBox "Please enter your information into row " & rowWithDefaultText, vbInformation, "Data Entered in Wrong Row"
Target.Clear
Cells(rowWithDefaultText, USER_ENTRY_COL).Activate
'' 'Moves whatever the user entered, from the wrong cell into the right cell
'' Dim name As Variant
'' name = Target.Cells(1, 1).Value
'' Target.Clear
'' Cells(rowWithDefaultText, USER_ENTRY_COL).Value = name
End If
Et ajoutez les 2 fonctions suivantes pour prendre en charge ce test secondaire:
'//Checks the last populated cell in a continuous range moving
'//down the worksheet against the row number passed in 'entryRow'
'//to see if they are a match
'@PARAM colNum - The column number for the column to be searched
'@PARAM startRow - The row at which to begin the search
'@PARAM entryRow - The row to test against
Private Function entry_row_and_correct_row_match(ByVal colNum As Integer, _
ByVal startRow As Long, ByVal entryRow As Long) As Boolean
Dim correctRow As Long
correctRow = find_last_xlDown_row(colNum, 1)
entry_row_and_correct_row_match = (entryRow = correctRow)
End Function
'//Finds the last populated cell going down a row, beginning on the
'//starting row number you provide.
'//ASSUME:Range is continuous in the targeted column!
'@PARAM colNum - The column number for the column to be searched
'@PARAM startRow - The row at which to begin the search
Public Function find_last_xlDown_row(ByVal colNum As Integer, _
ByVal startRow As Long) As Long
find_last_xlDown_row = Cells(startRow, colNum).End(xlDown).Row
End Function
En passant, vous voudrez peut-être envisager de modifier le texte inséré par vba pour lire "Entrez votre nom ici "; L'ajout de ce mot peut réduire le nombre d'instances signalant ce problème.
Remarque: tout ce code peut être inséré dans la page de code de la feuille de calcul.
J'espère que cela vous aidera, Nim
