Question

我有此代码来检查ID号，然后将ID所在的行复制到另一个电子表格中。如果用户表单中输入的ID号不存在，我希望出现一条错误消息，提示您重试，并且还会取消输入的ID号存在时执行的所有代码

我尝试了一个简单的If语句，但没有使它起作用

Option Explicit

Private Sub CommandButton1_Click()

Dim wsSource As Worksheet
Set wsSource = Sheets("Arkiv")
Dim wsDestination As Worksheet
Set wsDestination = Sheets("DN")

Dim IDnum As String
IDnum = TextBox1.Text

Dim idRow As Long
idRow = wsSource.Columns("A:A").Find(what:=IDnum, lookat:=xlWhole).Row

Dim SourceAdresses() As Variant
SourceAdresses = Array("B" & idRow, "C" & idRow, "D" & idRow, "E" & idRow, "F" & idRow, "G" & idRow, "H" & idRow, "I" & idRow)

Dim DestinationAdresses() As Variant
DestinationAdresses = Array("D9", "E9", "I9", "C20", "D20", "E45", "g20", "H20", "I20")

Dim i As Long
For i = LBound(SourceAdresses) To UBound(SourceAdresses)
    wsDestination.Range(DestinationAdresses(i)).Value = wsSource.Range(SourceAdresses(i)).Value
Next i

wsDestination.Activate
Unload Me
MsgBox "Data is now available"

End Sub

我希望用户表单提示“错误，未找到ID /存档中不存在ID”消息，并取消执行以下所有代码，然后让您重试输入ID

Answer 1

我不确定您的整个过程，但是下面的代码（未经测试）应该能够使您有所了解，以创建此错误处理。实际上，使用For循环可以做到这一点...

Option Explicit

Private Sub CommandButton1_Click()

    Dim wsSource As Worksheet
    Set wsSource = Sheets("Arkiv")
    Dim wsDestination As Worksheet
    Set wsDestination = Sheets("DN")

    Dim IDnum As String
    Dim idRow As Long
    Dim SourceAdresses() As Variant
    Dim DestinationAdresses() As Variant
    Dim i As Long, j As Long

    For j = 1 To 5

        IDnum = TextBox1.Text
        idRow = wsSource.Columns("A:A").Find(what:=IDnum, lookat:=xlWhole).Row

        If idRow = 0 Then
            MsgBox "Error finding ID number! Please try again!"
        Else
            Exit For
        End If

        If j = 5 Then
            'number of attempts exceeded - end program
            MsgBox "Could not locate the ID number! Closing program.."
            Exit Sub
        End If
    Next j

    SourceAdresses = Array("B" & idRow, "C" & idRow, "D" & idRow, "E" & idRow, "F" & idRow, "G" & idRow, "H" & idRow, "I" & idRow)
    DestinationAdresses = Array("D9", "E9", "I9", "C20", "D20", "E45", "G20", "H20", "I20")

    For i = LBound(SourceAdresses) To UBound(SourceAdresses)
        wsDestination.Range(DestinationAdresses(i)).Value = wsSource.Range(SourceAdresses(i)).Value
    Next i

    wsDestination.Activate

    Unload Me
    MsgBox "Data is now available"

End Sub

如何在此代码中添加验证检查？

1 个答案: