VBScriptで多次元配列 そにょ１･･･

日付処理の続きを記述する前に、必須スクリプトなど１つ･･･


    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    'inArrays - 多次元配列構築     
    '- Created by LazwardFox -     
         
        '配列 及び 文字列から、区切り文字を指定して多次元配列を作成し返す。     
         
        ' LastUpdate 20090228 0833     
         
    Function inArrays(tSources, strLimitters, arReturn)     
        Dim arSources, arLimitters, iLimitter, arInArrays, iSource, Pc     
        arSources = tSources     
        arLimitters = Split(strLimitters,"~")     
        For Each iLimitter In arLimitters     
            If VarType(arSources) = 8 Then     
                arInArrays = Split(arSources,iLimitter)     
            Else      
                Pc = 0     
                ReDim arInArrays(0)     
                For Each iSource in arSources     
                    ReDim Preserve arInArrays(Pc)     
                    arInArrays(Pc) = Split(iSource,iLimitter)     
                    Pc = Pc + 1     
                Next     
            End If     
            arSources = arInArrays     
            arInArrays = Null     
        Next     
        arReturn = arSources     
    End Function     

 
書式)
   inArrays(tSources, strLimitters, arReturn)
  
     tSourcess      - 区切り文字を含む文字列 ないし、それらで構成された配列変数を指定        
     strLimitters   - 区切り文字を、~(チルダ) で 区切って順番に並べた文字列を記述
     arReturn       - 戻り値(配列)が代入されます。任意の変数名を指定


説明面倒っちぃので、実例など･･･
  Const strWeekdays = "1:月:MON:Mon:Monday,2:火:TUE:Tue:Tuesday,3:水:WED:Wed:Wednesday,4:木:THU:Thu:Thursday,5:金:FRI:Fri:Friday,6:土:SAT:Sat:Saturday,7:日:SUN:Sun:Sunday"    
  Dim arWeekday, sD

  '配列を代入
  arWeekday = Split(strWeekdays,",")
  inArrays arWeekday, ":", sD
  msgbox sD(2)(3),,"Test"

  '文字列を代入
  inArrays strWeekdays, ",~:", sD
  msgbox sD(2)(3),,"Test"


上記２つは等価処理なので、結果は同じとなります。▼▼▼ p.s. そにょ２で修正された版です。▼▼▼▼▼▼▼▼▼▼▼▼▼

★上記実行サンプルとの差異
  '文字列を代入
   inArrays strWeekdays, ",~:", sD    
            ▼
   inArrays strWeekdays, ",:", sD


書式)
   inArrays(tSources, strLimitters, arReturn)
  
     tSourcess      - 区切り文字を含む文字列 ないし、それらで構成された配列変数を指定        
     strLimitters   - 区切り文字を、次元の浅さ順に並べた文字列を記述
     arReturn       - 戻り値(配列)が代入されます。任意の変数名を指定


        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    'inArrays － 多次元配列構築     
    '- Created by LazwardFox -     
         
        '配列 及び 文字列から、区切り文字を指定して多重化された配列、多次元配列を作成し返す。     
         
        ' Update 20090228 1248 strLimitters指定に、区切り文字 ~(チルダ)不要に。     
        ' Update 20090228 0833 外部関数 lArray 追加、配列のほか、文字列もソースに適用可能に。     
        ' Update 20090223 0917     
             
        ' inArrays(     
        '         tSources  － 区切り文字を含む文字列 ないし、それらで構成された配列     
        '        ,strLimitters  － 区切り文字を順番に並べた文字列を指定     
        '        ,arReturn  － 戻り値が代入されます。     
        '        )     
             
        Function inArrays(tSources, strLimitters, arReturn)     
            Dim arSources, arLimitters, iLimitter, arInArrays, iSource, Pc     
            arSources = tSources     
            lArray strLimitters, arLimitters '＜ Update 20090228 1248     
            For Each iLimitter In arLimitters     
                If VarType(arSources) = 8 Then     
                    arInArrays = Split(arSources,iLimitter)     
                Else      
                    Pc = 0     
                    ReDim arInArrays(0)     
                For Each iSource in arSources     
                    ReDim Preserve arInArrays(Pc)     
                    arInArrays(Pc) = Split(iSource,iLimitter)     
                    Pc = Pc + 1     
                Next     
                End If     
                arSources = arInArrays     
                arInArrays = Null     
            Next     
            arReturn = arSources     
        End Function     
             
    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    '文字列を１文字ずつバラし、配列として返す     
    '- Created by LazwardFox -     
         
        ' Release 20090228 1246     
         
        ' lArray(     
        '        strLetters  － 分解したい文字列     
        '       ,rArray  － 戻り値が代入されます。任意の変数名を指定      
        '       )     
         
        Function lArray(strLetters, rArray)     
            Dim Pc, rLetters()     
            Set objADO = CreateObject("ADODB.Stream")     
            With objADO     
                .Type = 2     
                .Open     
                .WriteText strLetters     
                Pc = 0     
                .Position = 0     
                Do Until .EOS     
                    ReDim Preserve rLetters(Pc)     
                    rLetters(Pc) = .ReadText(1)     
                    Pc = Pc + 1     
                Loop     
            End With     
            rArray = rLetters     
            objADO.Close     
            Set objADO = Nothing     
        End Function