Question

我正在写一个用于搜索和分类条形码的小宏。

这个想法是将条形码扫描到单元格C1中，然后假设该宏计算出扫描相同代码的次数。如果条形码不在列表中（列B：B），则应在列表中添加新条形码（列B：B）。

我已经设法使用Find（）语法，但是我无法使用它来编辑任何单元格。我唯一能做的就是MsgBox“”我尝试过：

Range("a5").Value = 5

它不起作用

这是我当前拥有的代码：

Private Sub Worksheet_Change(ByVal Target As Range)    
    If Range("C1") = "" Then MsgBox "No input"

    Dim barcodes As Range        
    Set barcodes = Range("B:B").Find(What:=Range("C1").Value, After:=Range("B2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True, MatchByte:=True, SearchFormat:=False)

    If Not barcodes Is Nothing And Not Range("C1") = "" Then
        MsgBox "Found"
    End If

    If barcodes Is Nothing And Not Range("C1") = "" Then
        MsgBox "New product"
    End If
End Sub

对于MsgBox "Found"，我想要一个代码来计算右侧相邻单元格中扫描相同条形码的次数。

对于Msgbox "New product"，我想编写一个将新代码添加到列表的部分，在这种情况下，列B：B

Answer 1

以下内容将 A）验证您是否没有匹配项（使用IsError，它返回布尔值）以确定是否需要添加值并开始扫描如果需要查找上一个条目（使用Match()并添加到计数器，则计数为1，或者为 B）：

If IsError(Application.Match(Cells(1,3).Value,Columns(2),0)) Then 
    lr = cells(rows.count,2).end(xlup).row
    Cells(lr+1,2).Value = Cells(1,3).Value
    Cells(lr+1,1).Value = 1
Else 
    r = Application.match(Cells(1,3).Value,Columns(2),0)
    cells(r,1).value = cells(r,1).value + 1
End If

编辑1：

OP中每个注释的第二个子例程的列号已更新，同时删除了第一个子例程并重新写了字。

Answer 2

使用此代码，您将需要一个名为“数据库”的工作表，您将在其中存储每次扫描，以后将成为数据透视表的源代码：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Barcode As String, i As Long, wsDB As Worksheet, LastRow As Long
    Dim DictBarcodes As New Scripting.Dictionary 'You need to check the Microsoft Scripting Runtime reference for this to work

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set wsDB = ThisWorkbook.Sheets("DataBase")

    With Target
        If .Range("C1") = vbNullString Then MsgBox "No input"
        On Error Resume Next

        'loop through all the barcodes and store them into a dictionary
        For i = 1 To .Rows.Count
            If .Cells(i, 2) = vbNullString Then Exit For 'skip the loop once a blank cell is found
            DictBarcodes.Add .Cells(i, 1), i 'this will raise an error if there are duplicates
        Next i

        'If the value doesn't exist we add it to the list
        If Not DictBarcodes.Exists(.Cells(1, 3)) Then
            LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
            .Cells(LastRow, 2) = .Cells(1, 3)
        End If
    End With

    'Either it exists or not, store it to the data base to keep tracking
    With wsDB
        .Cells(1, 1) = "Barcode"
        .Cells(1, 2) = "Date Scan"
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(LastRow, 1) = .Cells(1, 3)
        .Cells(LastRow, 2) = Now
    End With

    'Finally the output on the adjacent cell
    Target.Cells(1, 4) = Application.CountIf(wsDB.Range("A:A"), Target.Cells(1, 3))

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

使用Find（）编辑（相邻）单元格

2 个答案: