从用户窗体文本框修改行时出现运行时错误 424

Question

我正在尝试创建一个可编辑的用户表单，它将在“数据”工作表中搜索特定值，选择偏移单元格并将它们替换为文本框中的信息。

通过双击前一个用户表单列表框填充用户表单。

Initialize 事件正在工作，将正确的信息添加到所需的文本/cbo 框中，但是我想要一个“更新”cmd 按钮来搜索 txtup1 中的数字并更改偏移单元格中的值。

我收到运行时错误 424 no option 消息，但我不知道为什么。

Private Sub UserForm_Initialize()

'dim the variables
Dim i As Integer
On Error Resume Next

'find the selected list item
i = frmenqnew.lstenq.ListIndex

'add the values to the text boxes
Me.txtup1.Value = frmenqnew.lstenq.Column(0, i)
Me.txtup2.Value = frmenqnew.lstenq.Column(1, i)
Me.cboup3.Value = frmenqnew.lstenq.Column(4, i)
Me.cboup4.Value = frmenqnew.lstenq.Column(5, i)
Me.cboup5.Value = frmenqnew.lstenq.Column(6, i)
Me.cboup6.Value = frmenqnew.lstenq.Column(7, i)
Me.txtrev.Value = frmenqnew.lstenq.Column(9, i)

With cboup5
    .AddItem "Active"
    .AddItem "Dormant"
    .AddItem "Lost"
    .AddItem "Sold"
End With

With cboup6
    .AddItem "Drawing"
    .AddItem "Appraisal"
    .AddItem "Verification"
    .AddItem "Presenting"
End With

On Error GoTo 0
End Sub

'====================================================================

Private Sub cmdUpdate_Click()

'declare the variables
Dim findvalue As Range
Dim cNum As Integer
Dim DataSH As Worksheet

'error handling
On Error GoTo errHandler:
'hold in memory and stop screen flicker
Application.ScreenUpdating = False
Set DataSH = Sheet1

'check for values
If txtup1.Value = "" Or txtup2.Value = "" Then
    MsgBox "There is no data to edit"
    Exit Sub
End If

'clear the listbox
lstenq.RowSource = ""

'find the row to edit
Set findvalue = DataSH.Range("A:A"). _
Find(What:=txtup1.Value, LookIn:=xlValues, LookAt:=xlWhole)

'update the values
findvalue = txtup1.Value
findvalue.Offset(0, 5) = cboup3.Value
findvalue.Offset(0, 6) = cboup4.Value
findvalue.Offset(0, 7) = cboup5.Value
findvalue.Offset(0, 8) = cboup6.Value

'unprotect the worksheets for the advanced filter
'Unprotect_All
'filter the data
DataSH.Range("A8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Data!$P$8:$P$9"), CopyToRange:=Range("Data!$R$8:$AE$8"), _
Unique:=False

'if no data exists then clear the rowsource
If DataSH.Range("P9").Value = "" Then
    lstenq.RowSource = ""
Else
    'add the filtered data to the rowsource
    lstenq.RowSource = DataSH.Range("outdata").Address(external:=True)
End If

'return to sheet
Sheet2.Select
'Protect all sheets
'Protect_All
'error block
On Error GoTo 0
Exit Sub

errHandler:
'Protect all sheets
'Protect_All
'show error information in a messagebox
MsgBox "An Error has Occurred " & vbCrLf & _
"The error number is: " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & "Please notify the administrator"

End Sub

任何帮助将不胜感激

Answer 1

我也无法让您的代码正常工作。我没有分析它，而是插入了我自己的标准查找方法。您应该能够将其合并到您的表单中。我让它在常规模块中工作。

Sub changeCellsWithFindMethod()
Set ws1 = Worksheets("Sheet6")
txtup1 = "Hello"


With ws1.Range("a1:a500")
    Set findvalue = .Find(txtup1, LookIn:=xlValues)
    If Not findvalue Is Nothing Then
        firstAddress = findvalue.Address
        Do
            findvalue.Offset(0, 5) = "1"
            findvalue.Offset(0, 6) = "2"
            findvalue.Offset(0, 7) = "3"
            findvalue.Offset(0, 8) = "4"
            Set findvalue = .FindNext(findvalue)
        Loop While Not findvalue Is Nothing And findvalue.Address <> firstAddress
    End If
End With

End Sub

Answer 2

在网上搜索并遇到类似情况后，我能够得到想要的结果。

Private Sub cmdUpdate_Click()
' To write edited info of userform2 to Sheets("Data")
    Dim LastRow As Long
    Dim ABnum As Double
    Dim ABrng As Range
    Dim WriteRow As Long

' Make sure we're on the right sheet
Sheets("Data").Select
    With ActiveSheet
' Get the last row used so can set up the search range
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' Set the range to search for the AB number
        Set ABrng = .Range("A1:A" & LastRow)
' Get the AB number from what is selected on userform2
    ABnum = txtup1.Value
' Get the row of sheet for this AB number
    WriteRow = Application.Match(ABnum, ABrng, 0)

' Make this AB number the active cell
        Cells(WriteRow, 1).Select
' Write in all the editable stuff, don't bother with the non-editable things
        With ActiveCell
            .Offset(0, 4) = cboup3.Value
            .Offset(0, 5) = cboup4.Value
            .Offset(0, 6) = cboup5.Value
            .Offset(0, 7) = cboup6.Value

        End With
' Put the cursor in upper left corner
End With
' Unload the userform
'filter the data
    FilterMe
    Unload Me

End Sub

我现在将尝试添加一些代码来复制该行，然后再将其更新到单独的“存档”表