【原创LS程序 - 数组与字符串的相互转换

最新推荐文章于 2021-09-27 19:43:21 发布

置顶 shulia

最新推荐文章于 2021-09-27 19:43:21 发布

阅读量579

点赞数

文章标签： string function character date each

本文链接：https://blog.csdn.net/shulia/article/details/2461241

版权

作用：
针对字符串和数组，通过制定的区分字符来转化。根据需要可将字符串以制定符号区分转为数组，获将数组按照制定符号组合成字符串。
程序如下Function array_str (para As Variant, separ As String, empty As String) As Variant
'=========================================================================================
'    This function is use to convert array and string
'    para is the array or string, separ is the separate character.
'    if para is a string, the function will convert the para to array by the separate character
'    if para is array, the function will convert the para to string and connect each value by separate
'    empty mean if the value is empty, which character could replace it. it better doesn't use "" to do it since
'    in array, the null/empty could be removed.
'    for example : array(10) [1,2,3,4,5,6,7,8,9,0] and string [1:2:3:4:5:6:7:8:9:0]
'    array_str(array(10),":") = string
'    array_str(string,":") = array(10)
'    Programmer: Jacky Shu
'    Date: 2008-05-13
'
'
'=========================================================================================
    On Error Goto sl

    Dim m,n As String
    Dim a() As Variant
    m = Ubound(para)
    n = 0
    If m = 0 Then ' non array
        If Not Isempty(para) Then
            array_str = empty
            Exit Function
        End If
        For x = 1 To Len(para)
            If Mid(para,x,1) = separ Then
                n = n + 1
            End If
        Next
        Redim a(n+1)
        For y = 0 To n
            a(y) = Strleft(para,separ)
            para = Strright(para,separ)
        Next
        a(n+1) = Strrightback(para,separ)
        array_str = a
        Exit Function
    Else    ' array
        array_str = ""
        Forall r In para
            array_str = array_str & Cstr(separ) & Cstr(r)
        End Forall
        array_str = Strright(array_str,separ)
        Exit Function
    End If

sl:
    Msgbox "Error message is : " & Error & Chr(13) & "Error at line : " & Erl
End Function