为什么 ActiveX 命令按钮不运行我的 VBA 用户窗体中的所有代码？

Question

我是 Excel VBA 的新手，我目前正在尝试在 Excel VBA 上进行项目。我创建了一个用户表单，它允许用户通过填写​​用户表单中的字段将数据输入到 Excel 工作表中。我已经单独测试了所有代码，它们运行良好。

为了让用户访问用户窗体，我在同一工作簿的单独工作表上添加了一个 ActiveX 命令按钮。但是，当从 ActiveX 命令按钮访问用户窗体时，某些代码不会运行（主要是标记重复条目的代码，以及生成序列号的代码）。

我的代码哪里出错了？

这是我添加新数据的代码以及标记重复条目的代码。从 ActiveX 命令按钮打开用户窗体时，添加新数据可以正常工作，但它不会标记数据中的重复条目。 （但是，在 VBA 中测试代码本身可以正常工作）。

Private Sub cmdAddNewCustomer_Click()
Dim count As Long
Dim lastrow As Long
Dim lCustomerID As String
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
'find first empty row in database
lrow = ws.Cells.Find(what:="*", searchorder:=xlRows, _
    Searchdirection:=xlPrevious, LookIn:=xlValues).Row + 1
    
lCustomerID = txtCustomerID

count = 0

With ws
    For currentrow = 1 To lrow
        If lCustomerID = Cells(currentrow, 1) Then
           count = count + 1
        End If
    
    If count > 1 Then
        .Cells(currentrow, 1).Value = ""
        .Cells(currentrow, 2).Value = ""
        .Cells(currentrow, 3).Value = ""
        .Cells(currentrow, 4).Value = ""
        .Cells(currentrow, 5).Value = ""
        .Cells(currentrow, 6).Value = ""
        .Cells(currentrow, 7).Value = ""
        .Cells(currentrow, 8).Value = ""
        .Cells(currentrow, 9).Value = ""
        .Cells(currentrow, 10).Value = ""
        .Cells(currentrow, 11).Value = ""
        .Cells(currentrow, 12).Value = ""
        .Cells(currentrow, 13).Value = ""
        .Cells(currentrow, 14).Value = ""
        MsgBox ("CustomerID already exists!")
    End If
    
    If count = 0 Then
        .Cells(lrow, 1).Value = Me.txtCustomerID.Value
        .Cells(lrow, 2).Value = Me.txtCustomerName.Value
        .Cells(lrow, 3).Value = Me.cboCustomerStatus.Value
        .Cells(lrow, 4).Value = Me.txtContactPerson.Value
        .Cells(lrow, 5).Value = Me.cboDepartment.Value
        .Cells(lrow, 6).Value = Me.txtPosition.Value
        .Cells(lrow, 7).Value = Me.cboRoleType.Value
        .Cells(lrow, 8).Value = Me.txtofficeHP1.Value
        .Cells(lrow, 9).Value = Me.txtOfficeHP2.Value
        .Cells(lrow, 10).Value = Me.txtMobileHP1.Value
        .Cells(lrow, 11).Value = Me.txtMobileHP2.Value
        .Cells(lrow, 12).Value = Me.txtEmail1.Value
        .Cells(lrow, 13).Value = Me.txtEmail2.Value
        .Cells(lrow, 14).Value = Me.txtEmail3.Value
    End If
Next currentrow
End With
'clear the data
Me.txtCustomerName.Value = ""
Me.cboCustomerStatus.Value = ""
Me.txtContactPerson.Value = ""
Me.cboDepartment.Value = ""
Me.txtPosition.Value = ""
Me.cboRoleType.Value = ""
Me.txtofficeHP1.Value = ""
Me.txtOfficeHP2.Value = ""
Me.txtMobileHP1.Value = ""
Me.txtMobileHP2.Value = ""
Me.txtEmail1.Value = ""
Me.txtEmail2.Value = ""
Me.txtEmail3.Value = ""

End Sub

这是生成序列号的代码。 （同样的问题，通过 ActiveX 命令按钮访问时不起作用，但在 VBA 中单独测试时工作正常）。

Sub FindCustomerID()
Dim lastrow
Dim lastnum As Long
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
If Me.cboCountry = "" Or Me.txtCustomerName = "" Then
    Exit Sub
End If

serialno = 1

lastrow = ws.Cells(Rows.count, 1).End(xlUp).Row

CountryCode = UCase(Left(Me.cboCountry, 3))
CustomerCode = UCase(Left(Me.txtCustomerName, 10))

'assemble them into CustomerID
CustomerID = CountryCode & CustomerCode & serialno

For currentrow = 2 To lastrow
    If CustomerID = Cells(currentrow, 1) Then
        'find last number that applies
        serialno = serialno + 1
    End If
    're-assign customerID with new serial number
CustomerID = CountryCode & CustomerCode & serialno
Next currentrow

Me.lblCustomerID = CustomerID

End Sub

最后，这是来自 ActiveX 命令按钮的代码，用于显示用户窗体。

Private Sub cmdNCustomerData_Click()

frmCustomerdata.Show

End Sub

Answer 1

您描述的问题的原因是缺少. 来限定Cells(currentrow, 1)。因为您将 ActiveX 按钮添加到不同的工作表，所以行

If lCustomerID = Cells(currentrow, 1) Then

访问该工作表的Cells(currentrow, 1)。要解决此问题，需要使用. 限定范围以成为

If lCustomerID = .Cells(currentrow, 1) Then

我也愿意

If count = 0 Then
.
.
.
End If

在循环之外。您不必要地重复这些行很多次。

然后第一块代码变成：

Private Sub cmdAddNewCustomer_Click()
Dim count As Long
Dim lastrow As Long
Dim lCustomerID As String
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
'find first empty row in database
lrow = ws.Cells.Find(what:="*", searchorder:=xlRows, _
    Searchdirection:=xlPrevious, LookIn:=xlValues).Row + 1
    
lCustomerID = txtCustomerID

count = 0

With ws
    ' Count backward to delete rows completely
    For currentrow = lrow - 1 To 1 Step -1
        If lCustomerID = .Cells(currentrow, 1) Then
           count = count + 1
        End If
    
        If count > 1 Then
            .Cells(currentrow, 1).Resize(1, 14).ClearContents
            ' Uncomment the following line to delete the whole row completely
            '.Rows(currentrow).Delete
        End If
    
    Next currentrow
    
    If count > 1 Then
        MsgBox (count - 1 " duplicates of CustomerID found and cleared!")
    ElseIf count = 0 Then
        .Cells(lrow, 1).Value = Me.txtCustomerID.Value
        .Cells(lrow, 2).Value = Me.txtCustomerName.Value
        .Cells(lrow, 3).Value = Me.cboCustomerStatus.Value
        .Cells(lrow, 4).Value = Me.txtContactPerson.Value
        .Cells(lrow, 5).Value = Me.cboDepartment.Value
        .Cells(lrow, 6).Value = Me.txtPosition.Value
        .Cells(lrow, 7).Value = Me.cboRoleType.Value
        .Cells(lrow, 8).Value = Me.txtofficeHP1.Value
        .Cells(lrow, 9).Value = Me.txtOfficeHP2.Value
        .Cells(lrow, 10).Value = Me.txtMobileHP1.Value
        .Cells(lrow, 11).Value = Me.txtMobileHP2.Value
        .Cells(lrow, 12).Value = Me.txtEmail1.Value
        .Cells(lrow, 13).Value = Me.txtEmail2.Value
        .Cells(lrow, 14).Value = Me.txtEmail3.Value
    End If
End With
'clear the data
Me.txtCustomerName.Value = ""
Me.cboCustomerStatus.Value = ""
Me.txtContactPerson.Value = ""
Me.cboDepartment.Value = ""
Me.txtPosition.Value = ""
Me.cboRoleType.Value = ""
Me.txtofficeHP1.Value = ""
Me.txtOfficeHP2.Value = ""
Me.txtMobileHP1.Value = ""
Me.txtMobileHP2.Value = ""
Me.txtEmail1.Value = ""
Me.txtEmail2.Value = ""
Me.txtEmail3.Value = ""

End Sub

在FindCustomerID 子例程中，您的行有完全相同的问题

If CustomerID = Cells(currentrow, 1) Then

因为Cells(currentrow, 1) 不合格，因此应该成为

If CustomerID = ws.Cells(currentrow, 1) Then

您还不必要地多次重新分配CustomerID。我会在If 语句中进行重新分配，循环将变为

For currentrow = 2 To lastrow
    If CustomerID = ws.Cells(currentrow, 1) Then
        'find last number that applies
        serialno = serialno + 1
        're-assign customerID with new serial number
        CustomerID = CountryCode & CustomerCode & serialno
    End If
Next currentrow

这种方式 CustomerID 仅当且仅当 serialno 更改时才会重新分配。