Question

我有一个辅助用户表单，可以根据列表框中的双击选择来编辑单元格数据。

用户表单有一个“更新”按钮，它将根据文本框和组合框的输入执行单元格中数据的更改。

一切都运行良好，但是我希望在更新行之前保留数据的“存档”。（基本上将行复制到'Archive'表4）

我尝试包含.Selection方法但是这会更改我的活动工作表并且不会显示更新信息。

以下是代码：

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

    'error statement
On Error GoTo errHandler:
'hold in memory and stop screen flicker
Application.ScreenUpdating = False
' 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 options
        With ActiveCell
            .Offset(0, 4) = cboup3.Value
            .Offset(0, 5) = cboup4.Value
            .Offset(0, 6) = cboup5.Value
            .Offset(0, 7) = cboup6.Value
            .Offset(0, 8) = Date
            .Offset(0, 12) = txtup9.Value
            .Offset(0, 13) = txtup8.Value

        End With

End With
' Filter the Data
    FilterMe
' Close the form
    Unload Me

    MsgBox ("Enquiry E0" + Me.txtup1.Text + " has been updated")

errHandler:
'Protect all sheets if error occurs
'Protect_All
'show error information in a messagebox
    If Err.Number <> 0 Then
    MsgBox "Error " & Err.Number & " just occured."
    End If

End Sub

Answer 1

我不完全确定你在问什么，但这是最好的猜测。我只是在你想要存储一个数据的地方做了一个刺，但如果我在正确的行上，那么可以修改代码以覆盖其他数据。如果您可以澄清有用的目标存档表。

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

'error statement
On Error GoTo errHandler:
'hold in memory and stop screen flicker
Application.ScreenUpdating = False
' Make sure we're on the right sheet
With Sheets("Data")
' 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
    With .Cells(WriteRow, 1)
' Write in all the editable options
    Sheets("Archive").Range("A" & Rows.Count).End(xlUp)(2).Resize(, 14).Value = .Resize(, 14).Value
        .Offset(0, 4) = cboup3.Value
        .Offset(0, 5) = cboup4.Value
        .Offset(0, 6) = cboup5.Value
        .Offset(0, 7) = cboup6.Value
        .Offset(0, 8) = Date
        .Offset(0, 12) = txtup9.Value
        .Offset(0, 13) = txtup8.Value
    End With
End With
' Filter the Data
FilterMe
' Close the form
Unload Me

MsgBox ("Enquiry E0" + Me.txtup1.Text + " has been updated")

errHandler:
'Protect all sheets if error occurs
'Protect_All
'show error information in a messagebox
If Err.Number <> 0 Then
    MsgBox "Error " & Err.Number & " just occured."
End If

End Sub

VBA Userform命令用于在编辑信息之前将行复制到工作表

1 个答案: