如何在VBA中用MID函数批量提取UPC奇数位字符计算校验位？

首先明确：VBA没有原生函数能一次性提取多个不连续位置的字符，但完全不用手动多次调用Mid拼接结果，用循环、数组或者正则就能简化操作。

下面给你几种实用的实现方式：

1. 循环遍历目标位置（最直观） #

直接按步长2遍历1、3、5、7、9、11这些奇数位置，逐个提取字符并累加，逻辑清晰好维护：

Function CalculateUPCCheckDigit(UPC As String) As Integer
    Dim sumOdd As Integer
    Dim i As Integer
    
    ' 计算奇数位（1、3、5...11）的和并乘3
    For i = 1 To 11 Step 2
        sumOdd = sumOdd + CInt(Mid(UPC, i, 1))
    Next i
    sumOdd = sumOdd * 3
    
    ' 补充完整校验位计算：加上偶数位求和，取10的补数
    Dim sumEven As Integer
    For i = 2 To 10 Step 2
        sumEven = sumEven + CInt(Mid(UPC, i, 1))
    Next i
    
    Dim total As Integer
    total = sumOdd + sumEven
    CalculateUPCCheckDigit = (10 - (total Mod 10)) Mod 10
End Function

2. 数组批量管理位置（更灵活） #

把需要提取的位置存到数组里，遍历数组提取字符，后续要调整位置的话，改数组就行：

Function GetUPCSumOdd(UPC As String) As Integer
    Dim positions As Variant
    positions = Array(1, 3, 5, 7, 9, 11) ' 直接指定目标位置
    Dim sum As Integer
    Dim pos As Variant
    
    For Each pos In positions
        sum = sum + CInt(Mid(UPC, pos, 1))
    Next pos
    
    GetUPCSumOdd = sum * 3
End Function

3. 正则表达式（进阶方案） #

如果熟悉正则，可以用VBScript的正则对象匹配目标字符，但代码稍复杂，适合进阶用户：

Function UPCSumOddWithRegex(UPC As String) As Integer
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    ' 正则模式定位1、3、5...11位的字符
    regex.Pattern = "(?<=^.{0}).|(?<=^.{2}).|(?<=^.{4}).|(?<=^.{6}).|(?<=^.{8}).|(?<=^.{10})."
    
    Dim matches As Object
    Set matches = regex.Execute(UPC)
    Dim sum As Integer
    Dim match As Object
    
    For Each match In matches
        sum = sum + CInt(match.Value)
    Next match
    
    UPCSumOddWithRegex = sum * 3
    Set regex = Nothing
    Set matches = Nothing
End Function

总的来说，前两种方法足够实用，没必要用正则过度复杂化。不需要手动重复写Mid调用，用循环或数组就能轻松搞定。

内容的提问来源于stack exchange，提问作者Gary Nolan