VBA Userform проверка изменений данных - PullRequest
0 голосов
/ 15 ноября 2018

Я использую форму пользователя для обновления данных на листе, у меня есть кнопка команды обновления, чтобы скопировать данные из листа «данные» в «архив» и заменить на листе «данные» (по сути, «архив») это журнал всех предыдущих строк, а «данные» - самая свежая информация)

Информация изменяется в текстовых и комбинированных полях

Я борюсь с тем, чтобы команда «update» сначала проверила, были ли внесены какие-либо изменения перед копированием данных, если нет, я хочу, чтобы в окне сообщения появилось сообщение «без изменений в данных, пожалуйста, закройте форму»

Вот код для пользовательской формы:

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

1 Ответ

0 голосов
/ 15 ноября 2018

Самый простой способ - написать функцию для сравнения значений.

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 «Ошибка» & Err.Number & «только что произошла».End If

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...