Question

我只在这两天工作 - 我正在为我的同事制作一个表格，以便将信息添加到数据库中。我知道怎么做 - 我们意识到我们需要检查机架，盒子和位置是否重复。如果按顺序找到所有这三个（即机架1，方框2，位置3），则表示采取了该位置。因此，我们希望确保不会发生 - 我实际上并不知道该怎么做 - 我一直试图将其他人的例子用于我住在那里的Frankenstein代码，但是不工作毫不奇怪 - 我对VBA的了解非常基础。

我收到错误代码1004。

以下是将信息保存到工作表的按钮代码。

 Private Sub CommandButton1_Click()
'declare
Dim iRow As Long
Dim ws As Worksheet
Dim ctl As Control
Dim dRec As String
Dim answer As Integer
Dim dRow As Long 'duplicate row

Set ws = Worksheets("Primer Organization")

'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'check for a sequence
 If Trim(Me.txtSequence.Value) = "" Then
  Me.txtSequence.SetFocus
  MsgBox "Please enter a proper Sequence."
  Exit Sub
End If
iRowCount = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


'***Error code here***
'concentrate the three tested fields
If Application.WorksheetFunction.CountIf(ws.Range("B3", ws.Cells(iRowCount, 4)), dRec) > 0 Then
'***

'if a duplicate is found assign its location to dRow
     dRow = Application.WorksheetFunction.Match(dRec, ws.Range("D:D"), False)
'Message to user
    answer = MsgBox("Duplicate Entry Found." & Chr(10) & "Do you want to o verwrite?", vbQuestion + vbYesNo, "Duplicate Found")

'if it's a yes
    If answer = vbYes Then
    'if user says yes copy to sheet
    'copy the data to the database/primer Table
    With ws

.Cells(iRow, 1).Value = Me.txtFreezer.Value
.Cells(iRow, 2).Value = Me.txtRack.Value
.Cells(iRow, 3).Value = Me.txtBox.Value
.Cells(iRow, 4).Value = Me.txtPosition.Value
.Cells(iRow, 5).Value = Me.txtOligo.Value
.Cells(iRow, 6).Value = Me.txtOligoName.Value
.Cells(iRow, 7).Value = Me.txtSequence.Value
.Cells(iRow, 8).Value = Me.txtSpecies.Value
.Cells(iRow, 9).Value = Me.txtGene.Value
.Cells(iRow, 10).Value = Me.txtAssay.Value
.Cells(iRow, 11).Value = Me.txtConc.Value
.Cells(iRow, 12).Value = Me.txtSource.Value
.Cells(iRow, 13).Value = Me.txtPur.Value
.Cells(iRow, 14).Value = Me.txtDate.Value
.Cells(iRow, 15).Value = Me.txtName.Value
.Cells(iRow, 16).Value = Me.txtUsername.Value
.Cells(iRow, 17).Value = Me.txtNotes.Value
.Cells(iRow, 18).Value = Me.txtTags.Value

 MsgBox "Primer Added To database. Yay!"
End With
Else
If answer = vbNo Then
Exit Sub

End If
End If
End If


End Sub

Answer 1

drec尚未设置值，导致countif([Range],"")。你什么都不能找。

我还没有看到任何明确表示这是错误的事情，但我看到的所有例子都有明确的标准。

如果需要，您可以随时COUNTBLANK。

Answer 2

你可以编写一个辅助函数来检查每个数据库记录列B，C和D以匹配相应的文本框条目，如果匹配，则返回True以及重复的记录行索引

Function IsPositionHeld(dataRng As Range, rack As String, box As String, position As String, dRow As Long) As Boolean
    Dim cell As Range
    For Each cell In dataRng.Columns(1).Cells 'loop through passed range first column cells
        If cell.Value = rack And cell.Offset(, 1) = box And cell.Offset(, 2) = position Then ' if duplicated record
            IsPositionHeld = True 'return True
            dRow = cell.row ' store the duplicated record row index
            Exit Function ' end the search
        End If
    Next
End Function

并且你的主要子可以如下利用它：

Option Explicit

Private Sub CommandButton1_Click()
    'declare
    Dim ws As Worksheet
    Dim answer As Integer
    Dim iRow As Long

    Set ws = Worksheets("Primer Organization")

    With Me
        'check for a sequence
        If Trim(.txtSequence.Value) = "" Then
            .txtSequence.SetFocus
            MsgBox "Please enter a proper Sequence."
            Exit Sub
        End If

        'find first empty row in database
        iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlValues).row + 1

        'search for any record with same Rack, Box and Position entries and if found, ask user if to overwrite
        If IsPositionHeld(ws.Range("B3", ws.Cells(iRow - 1, 4)), .txtRack, .txtBox, .txtPosition, iRow) Then _
            If MsgBox("Duplicate Entry Found at row " & iRow & Chr(10) & "Do you want to overwrite?", vbQuestion + vbYesNo, "Duplicate Found") = vbNo Then Exit Sub


        'if user says yes copy to sheet
        'copy the data to the database/primer Table
        ws.Cells(iRow, 1).Resize(, 18).Value = _
        Array(.txtFreezer.Value, _
             .txtRack.Value, _
             .txtBox.Value, _
             .txtPosition.Value, _
             .txtOligo.Value, _
             .txtOligoName.Value, _
             .txtSequence.Value, _
             .txtSpecies.Value, _
             .txtGene.Value, _
             .txtAssay.Value, _
             .txtConc.Value, _
             .txtSource.Value, _
             .txtPUR.Value, _
             .txtDate.Value, _
             .txtName.Value, _
             .txtUserName.Value, _
             Me.txtNotes.Value, _
             .txtTags.Value)

        MsgBox "Primer Added To database. Yay!"
    End With
End Sub

IsPositionHeld()函数的另一个选项是Autofilter()：

Function IsPositionHeld2(dataRng As Range, rack As String, box As String, position As String, dRow As Long) As Boolean
    With dataRng
        .AutoFilter Field:=1, Criteria1:=rack
        .AutoFilter Field:=2, Criteria1:=box
        .AutoFilter Field:=3, Criteria1:=position
        If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then
            IsPositionHeld2 = True
            dRow = .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells(1, 1).row
        End If
        .Parent.AutoFilterMode = False
    End With
End Function

在这种情况下你也会传递标题行

    If IsPositionHeld2(ws.Range("B2", ws.Cells(iRow - 1, 4)), .txtRack, .txtBox, .txtPosition, iRow) Then _
        If MsgBox("Duplicate Entry Found at row " & iRow & Chr(10) & "Do you want to overwrite?", vbQuestion + vbYesNo, "Duplicate Found") = vbNo Then Exit Sub

弗兰肯斯坦代码：错误1004

2 个答案: