DictionaryをDumpしたい - C#ATIA

実は、Dictionary・・・好きなんですよ。
分かる方には分かると思います。

但し、VBAを扱う人でDictionaryを避ける人の気持ちも分かります。
ブレークポイントでチェックするとですね・・・

"値"の所で表示されるのはKeyです。Valueについてはローカルウィンドウで
表示されないんです。(＝確認出来ない)

でも、好きなんですよ。メソッドを持たないオブジェクトのようなものなので。

Valueをローカルウィンドウで表示させる方法は、恐らくないと思うので、
何とかしてイミディエイトウィンドウに出力したいんです。

今までも何度か紹介している"Ariawase"ですが、こちらの"Core.bas"の
中にDump関数があります。
ariawase/src/Ariawase.xlsm/Core.bas at master · vbaidiot/ariawase · GitHub

これをちょっと試す事にします。

OptionExplicitSub dump_test()
    Debug.Print Dump(5)
    Debug.Print Dump(Array(5,"55",7))
    Debug.Print Dump(Array(5,Array(5,2),7))Dim dict AsObjectSet dict =CreateObject("Scripting.Dictionary")Dim dict2 AsObjectSet dict2 =CreateObject("Scripting.Dictionary")
    dict2.Add"5",15
    dict2.Add"6",16
    dict.Add"7",17
    dict.Add"8",18
    dict.Add9, dict2
    Debug.Print Dump(dict)Dim lst AsNew Collection
    lst.Add5
    Debug.Print Dump(lst)EndSub

あっ中身には意味が無いので。

実行するとこんな感じです。

5%
Array(5%, "55", 7%)
Array(5%, Array(5%, 2%), 7%)
Dictionary
Collection

配列に関してはキッチリ出力してくれるのですが、オブジェクトに関しては
オブジェクト名のみの出力です。
まぁ確かにそうなのですが、DictionaryをやっぱりDumpしたいんです。

そこで、ちょっとDump関数と関連する関数をちょっとお借りして、
配列の出力を参考にこんな感じで修正してみました。

''' @param x As Variant''' @return As StringFunction Dump( _ByVal x AsVariant)AsStringDim ty AsString: ty =TypeName(x)SelectCase ty
        Case"Boolean":     Dump = x
        Case"Integer":     Dump = x &"%"Case"Long":        Dump = x &"&"#If Win64 ThenCase"LongLong":    Dump = x &"^"#EndIfCase"Single":      Dump = x &"!"Case"Double":      Dump = x &"#"Case"Currency":    Dump = x &"@"Case"Byte":        Dump ="CByte("& x &")"Case"Decimal":     Dump ="CDec("& x &")"Case"Date":
            Dim d AsString, t AsStringIfAbs(x)>=1Then d =Month(x)&"/"&Day(x)&"/"&Year(x)IfNot IsInt(x)Then t =Format(x,"h:nn:ss AM/PM")
            Dump ="#"&Trim(d &" "& t)&"#"Case"String"If StrPtr(x)=0Then
                Dump ="vbNullString"Else
                Dump =""""&Replace(x,"""","""""")&""""EndIfCase"Error"IfIsMissing(x)Then
                Dump ="Missing"Else
                Dump ="CVErr("& ReMatch(CStr(x),"\d+")(0)&")"EndIfCase"ErrObject"
            Dump ="Err "& x.Number
        Case"Empty","Null","Nothing","Unknown"
            Dump = ty
        CaseElseIfIsObject(x)ThenIf ty ="Dictionary"ThenDimkeysAsVariantkeys= x.keys()Dim ar2 AsVariantReDim ar2(x.Count-1)Dim j AsLongFor j =0To x.Count-1: ar2(j)= Dump(keys(j))&":"& Dump(x(keys(j))): Next
                    Dump ="Dictionary("&Join(ar2,", ")&")"Else
                    Dump = ToStr(x)EndIfElseIfIsArray(x)ThenDim rnk AsInteger: rnk = ArrRank(x)If rnk =1ThenDim lb AsLong: lb =LBound(x)Dim ub AsLong: ub =UBound(x)Dim ar AsVariantIf ub - lb <0Then
                        ar =Array()ElseDim mx AsLong: mx =8-1Dim xb AsLong: xb =IIf(ub - lb < mx, ub, lb + mx)ReDim ar(lb To xb)Dim i AsLongFor i = lb To xb: ar(i)= Dump(x(i)): NextEndIf
                    Dump ="Array("&Join(ar,", ")&IIf(xb < ub,", ...","")&")"Else
                    Dump =Replace(ty,"()","("&String(rnk -1,",")&")")EndIfElse
                Err.Raise51EndIfEndSelectEndFunction''' @param num As Variant(Of Numeric Or Date)''' @return As BooleanFunction IsInt( _ByVal num AsVariant)AsBooleanIfIsDate(num)Then num =CDbl(num)IfNotIsNumeric(num)Then Err.Raise13
    
    IsInt = num =Fix(num)EndFunction''' @param expr As String''' @param ptrnFind As String''' @param iCase As Boolean''' @return As Variant(Of Array(Of String))PrivateFunction ReMatch( _ByVal expr AsString,ByVal ptrnFind AsString, _OptionalByVal iCase AsBoolean=False)AsVariantDim ret AsVariant: ret =Array()Dim regex AsObject:  Set regex = CreateRegExp(ptrnFind,IIf(iCase,"i",""))Dim ms AsObject:     Set ms = regex.Execute(expr)If ms.Count<1Then: GoTo Ending
    
    Dim sms AsObject:    Set sms = ms(0).SubMatches
    ReDim ret(sms.Count)
    
    ret(0)= ms.Item(0).ValueDim i AsIntegerFor i =1ToUBound(ret): ret(i)= sms.Item(i -1): Next
    
Ending:
    ReMatch = ret
EndFunction''' @param x As Variant''' @return As StringPrivateFunction ToStr(ByVal x AsVariant)AsStringIfIsObject(x)ThenOnErrorGoTo Err438
        ToStr = x.ToStr()OnErrorGoTo0ElseIfIsArray(x)Then
        ToStr =TypeName(x)Else
        ToStr = x
    EndIfGoTo Escape
    
Err438:
    Dim e As ErrObject: Set e = Err
    SelectCase e.Number
        Case438: ToStr =TypeName(x): ResumeNextCaseElse: Err.Raise e.Number, e.source, e.Description, e.HelpFile, e.HelpContext
    EndSelect
    
Escape:
EndFunction''' @param arr As Variant(Of Array(Of T))''' @return As IntegerPrivateFunction ArrRank( _ByVal arr AsVariant)AsIntegerIfNotIsArray(arr)Then Err.Raise13Dim x AsLongDim i AsInteger: i =0OnErrorResumeNextWhile Err.Number =0: x =UBound(arr, IncrPre(i)): Wend
    ArrRank = i -1EndFunction''' @param n As Variant''' @param stepVal As Variant''' @return As VariantPrivateFunction IncrPre( _ByRef n AsVariant, _OptionalByVal stepVal AsVariant=1)AsVariant

    n = n + stepVal: IncrPre = n

EndFunction

長いのですが、僕が書き替えたのは数行です・・・。

で、最初のテストコードを再度実行するとこんな感じです。

5%
Array(5%, "55", 7%)
Array(5%, Array(5%, 2%), 7%)
Dictionary("7":17%, "8":18%, 9%:Dictionary("5":15%, "6":16%))
Collection

見易いかどうかは別として、何とか中身の出力に成功です。

ん？Collectionの出力は？　って言いたいんですよね。
ローカルウィンドウで確認出来るから取りあえずはこのままで。

本音を書くとキー付きのCollectionの扱いを思い付かなかったので
止めました。

改めて思うのですがAriawaseは桁違いにすごい。