Excel中字符串处理--元拓铝模钢背楞代号取模处理

Function ss(str As String)

    Dim indexA, indexR, length As Integer
    Dim cd1, cd2, cd3, cd4, cd5, prefix, suffix As String
    Dim arr() As String
    
    prefix = VBA.Left(str, VBA.InStr(str, " "))
    If VBA.InStr(str, "-") > 0 Then
        suffix = VBA.Right(str, 2)
    Else
        suffix = ""
    End If
    str = Application.WorksheetFunction.Substitute(str, prefix, "")
    str = Application.WorksheetFunction.Substitute(str, suffix, "")
    arr = Split(str, "+")
    length = UBound(arr)
    
    If length = 0 Then
        indexA = VBA.InStr(str, "A")
        indexR = VBA.InStr(str, "R")
        If indexA * indexR > 0&nbs***bsp;indexR * VBA.InStr(VBA.Mid(str, indexR + 1), "R") > 0&nbs***bsp;indexA * VBA.InStr(VBA.Mid(str, indexA + 1), "A") > 0 Then
            ss = prefix & ssRound(VBA.Mid(str, 1, VBA.Len(str) - 2)) & VBA.Right(str, 2) & suffix
        Else
            ss = prefix & ssRoundAR(str) & suffix
        End If
        
    ElseIf length = 1 Then
        cd1 = ssRoundAR(CStr(arr(0)))
        cd2 = ssRoundAR(CStr(arr(1)))
        ss = prefix & cd1 & "+" & cd2 & suffix
        
    ElseIf length = 2 Then
        cd1 = ssRoundAR(CStr(arr(0)))
        cd2 = arr(1)
        cd3 = ssRoundAR(CStr(arr(2)))
        ss = prefix & cd1 & "+" & cd2 & "+" & cd3 & suffix
        
    ElseIf length = 3 Then
        cd1 = ssRoundAR(CStr(arr(0)))
        cd2 = arr(1)
        cd3 = arr(2)
        cd4 = ssRoundAR(CStr(arr(3)))
        ss = prefix & cd1 & "+" & cd2 & "+" & cd3 & "+" & cd4 & suffix
    
    ElseIf length = 4 Then
        cd1 = ssRoundAR(CStr(arr(0)))
        cd2 = arr(1)
        cd3 = arr(2)
        cd4 = arr(3)
        cd5 = ssRoundAR(CStr(arr(4)))
        ss = prefix & cd1 & "+" & cd2 & "+" & cd3 & "+" & cd4 & "+" & cd5 & suffix

    Else
        ss = ""
    End If
End Function

'求余数
Function ssRound(str As String)
    Dim i As Integer
    i = str Mod 50
    If i > (50 * 0.5) Then
        ssRound = str + (50 - i)
    Else
        ssRound = str - i
    End If
End Function

'求余数（带加工信息A、R）
Function ssRoundAR(str As String)

    Dim temp As String
    
    temp = VBA.Mid(str, 1, VBA.Len(str) - 1)
     If VBA.Right(str, 1) = "A"&nbs***bsp;VBA.Right(str, 1) = "R" Then
        ssRoundAR = ssRound(temp) & VBA.Right(str, 1)
     Else
        ssRoundAR = ssRound(temp) & ""
    End If
End Function


Sub sswr()

Dim Rng As Range

For Each Rng In Range("a2:a" & Range("a65536").End(xlUp).Row)
    Rng = ss(Rng.Value)
Next

End Sub