Kullanıcı çalışma sayfasındaki bir hücrenin içeriğini değiştirdiğinde ve kullanıcının kullanıcıyı uyarması veya girilenleri taşıması durumunda hedeflenen sütundaki bir hücrede varsayılan vba-girilen metin dizininizin olup olmadığını kontrol edebilirsiniz. hücreye girilmiş olması gerekir (her iki eylem de aşağıdaki koddadır, (Taşı seçeneği IF ELSE bloğunda yorumlanmıştır):
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
Yukarıdakiler, vba ile eklenen metnin kullanıcının ismini girmeden önce orada olduğunu varsayar; Bazı nedenlerden ötürü değilse, kullanıcının 2,3, 10 sıradan adlarını girmediğinden emin olmak için bir test yapılmaz. Bu durumda meydana gelen bir test eklemek isterseniz, IF ELSE şunun gibi görünecek şekilde değiştirilebilir:
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
Ve bu ikincil testi desteklemek için aşağıdaki 2 işlevi ekleyin:
'//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
BTW, "Adınızı girin" ifadesini okumak için vba tarafından eklenen metni değiştirmeyi düşünebilirsiniz. İşte "; Bir kelimenin eklenmesi, bu sorunu gördüğünüz örneklerin sayısını azaltabilir.
Not: Bu kodun tümü çalışma sayfasının kod sayfasına girebilir.
Bu yardımcı olur umarım,
Nim
