Question

我正在使用用户窗体来更新工作表中的数据，我有一个update命令按钮，用于将数据从“数据”工作表复制到“归档”并替换为“数据”工作表（本质上是“归档”是之前所有行的日志，“数据”是最新信息）

信息在文本框和组合框中已更改

我正在苦苦挣扎的是'update'cmdbutton，以便在复制数据之前先检查是否进行了任何更改，否则，我想让msg框读取'数据没有更改，请关闭表格'

这是到目前为止用户表单的代码：

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, 9) = txtrev.Value
        .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 = txtenqup.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)
            'Check for changes

            If Not hasValuePairsChanges(.Offset(0, 4).Value, cboup3.Value, _
                                        .Offset(0, 5).Value, cboup4.Value, _
                                        .Offset(0, 6).Value, cboup5.Value, _
                                        .Offset(0, 7).Value, cboup6.Value, _
                                        CDate(.Offset(0, 8).Value), Date, _
                                        CDbl(.Offset(0, 9).Value), CDbl(txtrev.Value), _
                                        .Offset(0, 12).Value, txtnotes.Value, _
                                        .Offset(0, 13).Value, txtdtime.Value) Then
                MsgBox "No Change in Data", vbInformation, ""
                Exit Sub
            End If

            ' 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, 9) = txtrev.Value
            .Offset(0, 12) = txtnotes.Value
            .Offset(0, 13) = txtdtime.Value
        End With
    End With
    ' Filter the Data
    FilterMe
    ' Close the form
    Unload Me

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

errHandler： '如果发生错误，保护所有工作表 'Protect_All '在消息框中显示错误信息如果Err.Number <> 0然后 MsgBox“错误”＆错误编号＆“刚刚发生。如果结束

End Sub

Function hasValuePairsChanges(ParamArray Args() As Variant) As Boolean
    Dim n As Long

    For n = 0 To UBound(Args) Step 2
        If Not Args(n) = Args(n + 1) Then
            hasValuePairsChanges = True
            Exit Function
        End If
    Next
End Function

VBA用户表单数据更改检查

1 个答案: