如何使用VBA实现Excel扫描不同前缀员工条码自动提取人员信息

实现方案 #

完全可以通过VBA实现需求，下面提供两种落地方式，可根据使用习惯选择：

方式1：自定义工作表函数（和普通Excel公式用法一致，直接在单元格调用） #

按Alt+F11打开VBA编辑器，插入新模块，粘贴以下代码：

' 自定义函数：提取Base32编码
Function GetBase32(barcode As String) As String
    If Len(barcode) = 0 Then
        GetBase32 = ""
        Exit Function
    End If
    Select Case UCase(Left(barcode, 1))
        Case "M"
            GetBase32 = Mid(barcode, 2, 7)
        Case "N"
            GetBase32 = Mid(barcode, 9, 7)
        Case "C"
            GetBase32 = Mid(barcode, 8, 7)
        Case Else
            GetBase32 = ""
    End Select
End Function

' 自定义函数：提取名字
Function GetFirstName(barcode As String) As String
    If Len(barcode) = 0 Then
        GetFirstName = ""
        Exit Function
    End If
    Select Case UCase(Left(barcode, 1))
        Case "M"
            GetFirstName = WorksheetFunction.Proper(Mid(barcode, 17, 20))
        Case "N"
            GetFirstName = WorksheetFunction.Proper(Mid(barcode, 16, 20))
        Case "C"
            GetFirstName = WorksheetFunction.Proper(Mid(barcode, 15, 20))
        Case Else
            GetFirstName = ""
    End Select
End Function

' 自定义函数：提取姓氏
Function GetLastName(barcode As String) As String
    If Len(barcode) = 0 Then
        GetLastName = ""
        Exit Function
    End If
    Select Case UCase(Left(barcode, 1))
        Case "M"
            GetLastName = WorksheetFunction.Proper(Mid(barcode, 38, 20))
        Case "N"
            GetLastName = WorksheetFunction.Proper(Mid(barcode, 36, 26))
        Case "C"
            GetLastName = WorksheetFunction.Proper(Mid(barcode, 35, 20))
        Case Else
            GetLastName = ""
    End Select
End Function

' 自定义函数：Base32转员工ID
Function Base32ToID(base32Str As String) As String
    If Len(base32Str) = 0 Then
        Base32ToID = "0"
        Exit Function
    End If
    Dim i As Long, char As String, charVal As Long, total As Double
    total = 0
    base32Str = UCase(base32Str)
    For i = 1 To Len(base32Str)
        char = Mid(base32Str, i, 1)
        If IsNumeric(char) Then
            charVal = Val(char)
        ElseIf Asc(char) >= 65 And Asc(char) <= 90 Then
            charVal = Asc(char) - 55
        Else
            Base32ToID = "0"
            Exit Function
        End If
        total = total + charVal * (32 ^ (Len(base32Str) - i))
    Next i
    Base32ToID = CStr(total)
End Function

将工作簿保存为**启用宏的工作簿（.xlsm格式）**后，即可在工作表直接调用函数：

• Base32列输入：=GetBase32(A2)
• 名字列输入：=GetFirstName(A2)
• 姓氏列输入：=GetLastName(A2)
• ID列输入：=Base32ToID(对应Base32单元格)，也可合并调用=Base32ToID(GetBase32(A2))

方式2：自动触发填充（扫描条码后自动填充所有字段，无需手动输入公式） #

如果需要扫描即出结果，可在当前工作表的代码窗口粘贴以下事件代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅监控A列的单单元格修改，匹配扫码枪逐行输入的使用场景
    If Target.Column <> 1 Or Target.CountLarge > 1 Then Exit Sub
    Dim barcode As String
    barcode = Trim(Target.Value)
    If Len(barcode) = 0 Then
        Range("B" & Target.Row & ":E" & Target.Row).ClearContents
        Exit Sub
    End If
    Range("B" & Target.Row) = GetBase32(barcode)
    Range("C" & Target.Row) = GetFirstName(barcode)
    Range("D" & Target.Row) = GetLastName(barcode)
    Range("E" & Target.Row) = Base32ToID(Range("B" & Target.Row).Value)
End Sub

注意：使用自动触发功能需要先将方式1中的4个自定义函数导入模块，否则会报错。

注意事项 #

• 所有桌面版Excel均支持上述VBA功能，无需依赖Office 365专属函数
• 工作簿必须保存为.xlsm格式，否则宏代码会失效
• 使用前需要在Excel信任中心启用宏，避免代码被系统拦截

内容的提问来源于stack exchange，提问作者Chris Schaeuble