vba 循环不检查重复零件号

Question

我需要我的循环来检查现有的部件号，并且只有在没有现有的部件号时才将其添加到我的 table。如果零件号已经存在，则有一个消息框说明它已经存在。将其添加到我的 table 就好了，但如果已有零件号，则不会给我消息框。

Private Sub Add_Click()

Dim ws As Worksheet
Set ws = Sheet4
Dim X As Integer
Dim lastrow As Long
Dim PartColumnIndex As Integer
Dim DescriptionColumnIndex As Integer

Const Part = "CM ECP"
Const Description = "Material Description"

Dim PartNum As String
Dim MaterailDescription As String

Dim tbl As ListObject

Set tbl = ws.ListObjects("Master")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add

With ws
    On Error Resume Next
    Let PartColumnIndex = WorksheetFunction.Match(PartNum, .Rows(2), 0)
    Let DescriptionColumnIndex = WorksheetFunction.Match(MaterialDecription, .Rows(2), 0)
    Let lastrow = .Cells(.Rows.Count, PartColumnIndex).End(xlUp).Row
    
    X = 3
    
    Do
        Let PartValue = .Cells(X, PartColumnIndex).Value
        Let DecriptionColumnIndex = .Cells(X, DecriptionColumnIndex).Value
        If TextBox1.Value = PartValue Then
            MsgBox "Part Number " + TextBox1.Value + " already exists. Please try again or return to main screen."
        ElseIf TextBox1.Value <> PartValue Then
            With newrow
                .Range(1) = TextBox1.Value
                .Range(2) = TextBox2.Value
            End With
        ElseIf X < lastrow Then
            X = X + 1
        
            
        End If
                 
        
    
    Loop Until X > lastrow

    End With

Answer 1

在决定是否添加新行之前扫描 table 中的所有行，并始终将 Use Option Explicit 添加到代码顶部以捕获错误，例如 DecriptionColumnIndex（没有 s).

Option Explicit

Sub Add_Click()

    Const PART = "CM ECP"
    Const DESCRIPTION = "Material Description"

    Dim ws As Worksheet
    Dim X As Integer, lastrow As Long
    Dim PartColumnIndex As Integer, DescrColumnIndex As Integer
    Dim PartNum As String, MaterialDescription As String
    Dim tbl As ListObject, bExists As Boolean
    
    Set ws = Sheet1
    Set tbl = ws.ListObjects("Master")
    With tbl
        
        PartColumnIndex = .ListColumns(PART).Index
        DescrColumnIndex = .ListColumns(DESCRIPTION).Index
        
        PartNum = Trim(TextBox1.Value)
        MaterialDescription = Trim(TextBox2.Value)
        
        ' search
        With .DataBodyRange
            lastrow = .Rows.Count
            For X = 1 To lastrow
                If .Cells(X, PartColumnIndex).Value = PartNum Then
                    bExists = True
                    Exit For
                End If
            Next
        End With
        
        ' result
        If bExists = True Then
            MsgBox "Part Number `" & PartNum & "` already exists on Row " & X & vbLf & _
            "Please try again or return to main screen.", vbExclamation
        Else
            With .ListRows.Add
                .Range(, PartColumnIndex) = PartNum
                .Range(, DescrColumnIndex) = MaterialDescription
            End With
            MsgBox "Part Number `" & PartNum & "` added", vbInformation
        End If
        
    End With
End Sub

vba 循环不检查重复零件号

vba loop no checking for duplicate part number

excel

vba

do-loops