Question

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

通过在先前的用户表单列表框中双击来填充用户表单。

Initialize事件正在运行，将正确的信息添加到所需的text / cbo框中，但我想要一个'Update'cmd按钮来搜索txtup1中的数字并更改偏移单元格中的值。

我收到运行时错误424没有选项消息，但我无法弄清楚原因。

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

我现在将尝试添加一些代码来复制行，然后再将其更新为单独的存档＆＃39;片

运行时错误424从userform文本框

2 个答案: