我正在更新这个,以防其他人可能需要它,并看看是否有人对此代码有任何建议(我对VBA很新,所以欢迎任何批评)。
以下代码将在给定工作表的第2列中搜索textBox1值。如果没有找到,它将添加信息。如果找到,它会找到所述查找的所有实例,并搜索文本框2的相邻列。如果未找到,则添加信息,如果找到则返回信息框。
`Private Sub cbAdd_Click()
Dim wss As Worksheet
Dim LR As Long
Dim Fnd As String, FF As String, Change As String
Dim FC As Range, LC As Range, Rng As Range, ChgId As Range
Dim FndChg As Range, SRange As Range, Rng2 As Range
'tb = Text Box, cb = Combo Box
'These are the values that need to be found, if present.
mis = tbMis.Text
Change = tbChg.Text
'Activate the Sheet to search in, then set the search criteria.
ThisWorkbook.Sheets("DB").Activate
Set wss = ThisWorkbook.Sheets("DB") 'wss for me is worksheet searched
Set SRange = wss.Columns(2) 'Sets the range to search with SRange as Column B of "DB"
Set LC = SRange.Cells(SRange.Cells.count) 'Finds the LastCell (LC) of the search range
Set FC = SRange.Find(what:=mis, after:=LC) 'FC is the First Cell found matching "mis"
LR = Cells(Rows.count, "A").End(xlUp).Row 'Finds the last row in the "DB" worksheet, used when adding the information.
'Checking to see if anything was found.
If FC Is Nothing Then
GoTo AddMis 'If the mis is not found, add the information.
End If
If Not FC Is Nothing Then 'If mis was found FF (First Found) is the address of where it was found.
FF = FC.Address
End If
Set Rng = FC
'This loops the search until it finds all instances of mis in column 2.
Do Until FC Is Nothing
Set FC = SRange.FindNext(after:=FC) 'Continues the search after the last found cell.
Set Rng = Union(Rng, FC) 'Adds the found cells to my range "Rng".
If FC.Address = FF Then Exit Do 'continues the loop until it cycles to the first found cell.
Loop
Rng.Select
Selection.Offset(0, 1).Select 'Selects adjacent cells in order to see if these match "change".
Set ChgId = Selection.Find(what:=Change, Lookat:=True) 'Will compare Column 3 against info input into "change"
If Not ChgId Is Nothing Then
GoTo Duplicate
Else
GoTo AddMis
End If
'Handlers
AddMis:
Sheets("DB").Range("A" & LR + 1).Value = tbSat.Text 'Adds the ComboBox1 selection to the next available row in column 1.
Sheets("DB").Range("A" & LR + 1).Offset(0, 1).Value = tbMis.Text 'Adds tbMis Text to the same row in column 2.
Sheets("DB").Range("A" & LR + 1).Offset(0, 2).Value = tbChg.Text 'Adds tbChg Text to the same row in column 3.
Sheets("DB").Range("A" & LR + 1).Offset(0, 3).Value = tbPri.Text 'Adds ComboBox2 selection to the same row in column 4.
Msgbox "Information added" 'Lets the user know the information has been added.
Unload Me 'Closes the Userform with the input fields
Exit Sub
Duplicate:
Msgbox "Information has already been input into the database." 'Lets the user know that the information already exists.
Unload Me
Exit Sub
End Sub'
我要感谢整个溢出社区,尽管在这个问题上可能没有明确的答案,但是其他可用的网站和知识库帮助我最终解决了这个问题。
答案 0 :(得分:0)
您可以使用.Offset
属性访问相对于特定单元格的单元格:
'...
If Not Rng Is Nothing Then
If Rng.Offset(0,1).Value = Findchange Then
MsgBox "Item already entered."
End If
Else
'...
你不能在一行(Not Rng Is Nothing And Rng.Offset(0,1).Value = Findchange
)内进行这两项检查,因为即使第一种情况不正确,VBA也会检查第二种情况。
您还可以搜索第1列而不是整个工作表:
Set Rng = ws.Columns(1).Find('...