Question

如果在textbox8中创建的数字已经存在，我有以下子检查单独的工作表，此时有一个消息框提醒用户该部件号已经存在，他们必须单击OK，然后number加1，重复该过程，直到找到唯一的数字。这是写入工作表以及其他一些数据。

我需要做的是删除消息框，以便它自动搜索并找到下一个可用的号码。

我在sub中添加了以下代码，但这没有效果：

Application.DisplayAlerts = False
  MsgBox "This already exists"
  SendKeys "{ENTER}"
Application.DisplayAlerts = True

码

'Create part number and check
Private Sub CommandButton2_Click()


With TextBox26
   If myreset = True Then
      .Tag = 0
      myreset = False
   End If
  .Tag = Val(.Tag) + 1
  .Text = "-" & VBA.Format(Val(.Tag), "0000")
End With


Dim iNum(1 To 8) As String
iNum(1) = TextBox24.Value
iNum(2) = TextBox25.Value
iNum(3) = TextBox26.Value


TextBox8.Value = iNum(1) + iNum(2) + iNum(3)

'check article exists

Dim emptyRow As Long
Dim rcnt As Long
Dim i As Long



ActiveWorkbook.Sheets("existing").Activate

rcnt = Sheets("existing").Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To rcnt

If TextBox8.Text = Sheets("existing").Range("A" & i).Value Then
Application.DisplayAlerts = False
  MsgBox "This already exists"
  SendKeys "{ENTER}"
 Application.DisplayAlerts = True

 Exit Sub
 End If
Next

Range("A1").Select
Do
If IsEmpty(ActiveCell) = False Then
  ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = TextBox8.Text

Answer 1

要删除消息Box，您需要删除代码中的以下行

Application.DisplayAlerts = False
  MsgBox "This already exists"
  SendKeys "{ENTER}"
 Application.DisplayAlerts = True

我不确定代码的第一部分是做什么的。如果你能提供一些例子，我可以提供帮助。但是我已经合理化了第二部分，现在这将实现原始代码试图以较小的线条实现的目标。

'check article exists

Dim emptyRow As Long
Dim rcnt As Long
Dim i As Long
Dim varProdCode  As Long

ActiveWorkbook.Sheets("existing").Activate
varProdCode = TextBox8.Text
rcnt = Sheets("existing").Range("A" & Rows.Count).End(xlUp).Row

Do Until varProdCode = 0
    For i = 2 To rcnt
        If varProdCode = Sheets("existing").Range("A" & i).Value Then
            varProdCode = varProdCode + 1
            Exit For
        Else
            Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = varProdCode
            varProdCode = 0
            Exit Sub
        End If
    Next
Loop

Answer 2

这是可行的代码

＆＃13;

Private Sub CommandButton2_Click()


        With TextBox26
               If myreset = True Then
                  .Tag = 0
                  myreset = False
               End If
              .Tag = Val(.Tag) + 1
              .Value = VBA.Format(Val(.Tag), "0000")
         End With
         
        Dim emptyRow As Long
        Dim rcnt As Long
        Dim c As Long
           
        rcnt = Sheets("existing").Range("A" & Rows.Count).End(xlUp).Row
           
        For c = 2 To rcnt
        Dim iNum(1 To 8) As String
        iNum(1) = TextBox24.Value
        iNum(2) = TextBox25.Value
        iNum(3) = TextBox26.Value

        'check if article exists

          
        ActiveWorkbook.Sheets("existing").Activate
            
           If Sheets("existing").Range("A" & c).Value = iNum(1) & iNum(2) & "-" & iNum(3) Then
            TextBox26.Value = TextBox26.Value + 1
            iNum(3) = TextBox26.Value
            End If
             Next c
             
        'create article number
        
        TextBox8.Value = iNum(1) + iNum(2) + "-" + iNum(3)
            
        'select first column
        
        Range("A1").Select

＆＃13;

查找给定值是否在单元格中，如果是，则尝试下一个值直到唯一

2 个答案: