Excel中运行VB的函数

"插入" -》 "模块"

vbscript 复制代码

Function FormatCodeFlex(inputStr As String, Optional defaultVal As String = "0") As String
    On Error GoTo ErrorHandler
    Dim parts() As String
    Dim i As Integer
    
    ' 使用 "-" 分割字符串
    parts = Split(inputStr, "-")
    
    ' 确保至少有3个部分，不足的用默认值填充
    ReDim Preserve parts(2)
    For i = 0 To 2
        If parts(i) = "" Then parts(i) = defaultVal
    Next i
    
    ' 格式化每个部分
    FormatCodeFlex = Format(parts(0), "00") & "-" & _
                    Format(parts(1), "000") & "-" & _
                    Format(parts(2), "000")
    
    Exit Function
    
ErrorHandler:
    FormatCodeFlex = "输入无效！"
End Function

可能需要编译一下。不记得了

调用

记录一下备忘。

写一个 excel中的vba函数，判断 01-000-000 中的最后三位如果是 000 就返回0，如果不是000，就替换为000，并且返回整个字符串。

Function ProcessBOMCode(inputStr As String) As String

On Error GoTo ErrorHandler

Dim parts() As String

Dim lastPart As String

' 检查输入是否为空

If Trim(inputStr) = "" Then

ProcessBOMCode = "输入为空"

Exit Function

End If

' 使用 "-" 分割字符串

parts = Split(inputStr, "-")

' 检查是否有足够的部分

If UBound(parts) < 2 Then

ProcessBOMCode = "格式错误，需要xx-xxx-xxx格式"

Exit Function

End If

' 获取最后三位

lastPart = parts(2)

' 判断最后三位是否为"000"

If lastPart = "000" Then

ProcessBOMCode = 0 ' 返回数字0

Else

' 替换最后三位为"000"，并返回整个字符串

parts(2) = "000"

ProcessBOMCode = parts(0) & "-" & parts(1) & "-" & parts(2)

End If

Exit Function

ErrorHandler:

ProcessBOMCode = "处理错误"

End Function

写一个excel的vba 处理 1 1-1 1-1-1 1-1-2 1-2 这样的不定长数据，去掉最后的一个数据。

Function RemoveLastPart(inputStr As String) As String

On Error GoTo ErrorHandler

Dim parts() As String

Dim result As String

Dim i As Integer

' 检查输入是否为空

If Trim(inputStr) = "" Then

RemoveLastPart = ""

Exit Function

End If

' 使用 "-" 分割字符串

parts = Split(inputStr, "-")

' 如果只有一个部分，直接返回空字符串

If UBound(parts) = 0 Then

RemoveLastPart = ""

Exit Function

End If

' 重新组合除最后一部分之外的所有部分

For i = 0 To UBound(parts) - 1

If i > 0 Then result = result & "-"

result = result & parts(i)

Next i

RemoveLastPart = result

Exit Function

ErrorHandler:

RemoveLastPart = "处理错误"

End Function

Deepseek真强。