вы могли бы просто проверить наличие по умолчанию ВБА-введенной текстовой строки в ячейке в целевой столбец, когда пользователь изменяет содержимое ячейки на листе, и если он будет найден либо предупредить пользователя, или что они вошли в клетку, она должна были заключены (оба действия в коде ниже (переезд параметр закомментирован в том случае, если блок 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
выше предполагается, что VBA-вставленный текст был там до пользователя ввод их имени; если по какой-то причине этого не было, то нет теста, чтобы убедиться, что пользователь не ввел свое имя 2,3, 10 строк вниз. Если вы хотите добавить тест, что случай происходит, если еще может быть изменен, чтобы выглядеть примерно так:
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
и добавьте следующие 2 функции для поддержки этого вторичного теста:
'//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
кстати, вы можете рассмотреть вопрос об изменении текста, вставленного vba, чтобы прочитать "введите свое имя здесь"; добавив, что одно слово может вырезать на количество экземпляров, вы видите эту проблему.
Примечание: весь этот код может перейти на кодовую страницу листа.
надеюсь, это поможет,
Nim
Komp
2466
