こちらの続きです。
DictionaryをDumpしたい1 - C#ATIA
タイトルは"Dictionary"が入ってますが、今回は"Collection”です。
調べたところ、キー付きのCollectionは、キーを列挙する方法が
無いんですね。と言う事で、Collectionもダンプさせるように
変更しました。
''' @param x As Variant ''' @return As String Function Dump( _ ByVal x As Variant) As String Dim ty As String: ty = TypeName(x) Select Case ty Case "Boolean": Dump = x Case "Integer": Dump = x & "%" Case "Long": Dump = x & "&" #If Win64 Then Case "LongLong": Dump = x & "^" #End If Case "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 As String, t As String If Abs(x) >= 1 Then d = Month(x) & "/" & Day(x) & "/" & Year(x) If Not IsInt(x) Then t = Format(x, "h:nn:ss AM/PM") Dump = "#" & Trim(d & " " & t) & "#" Case "String" If StrPtr(x) = 0 Then Dump = "vbNullString" Else Dump = """" & Replace(x, """", """""") & """" End If Case "Error" If IsMissing(x) Then Dump = "Missing" Else Dump = "CVErr(" & ReMatch(CStr(x), "\d+")(0) & ")" End If Case "ErrObject" Dump = "Err " & x.Number Case "Empty", "Null", "Nothing", "Unknown" Dump = ty Case Else If IsObject(x) Then Select Case ty Case "Dictionary" Dim keys As Variant keys = x.keys() Dim ar2 As Variant ReDim ar2(x.Count - 1) Dim j As Long For j = 0 To x.Count - 1: ar2(j) = Dump(keys(j)) & ":" & Dump(x(keys(j))): Next Dump = "Dictionary(" & Join(ar2, ", ") & ")" Case "Collection" Dim ar3 As Variant ReDim ar3(x.Count - 1) Dim k As Long For k = 1 To x.Count: ar3(k - 1) = Dump(x.Item(k)): Next Dump = "Collection(" & Join(ar3, ", ") & ")" Case Else Dump = ToStr(x) End Select ElseIf IsArray(x) Then Dim rnk As Integer: rnk = ArrRank(x) If rnk = 1 Then Dim lb As Long: lb = LBound(x) Dim ub As Long: ub = UBound(x) Dim ar As Variant If ub - lb < 0 Then ar = Array() Else Dim mx As Long: mx = 8 - 1 Dim xb As Long: xb = IIf(ub - lb < mx, ub, lb + mx) ReDim ar(lb To xb) Dim i As Long For i = lb To xb: ar(i) = Dump(x(i)): Next End If Dump = "Array(" & Join(ar, ", ") & IIf(xb < ub, ", ...", "") & ")" Else Dump = Replace(ty, "()", "(" & String(rnk - 1, ",") & ")") End If Else Err.Raise 51 End If End Select End Function
Dump関数以外は前回と変更なしです。
こちらがテストコードです。
Sub dump_test() Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") Dim dict2 As Object Set dict2 = CreateObject("Scripting.Dictionary") dict2.Add "5", 15 dict2.Add "6", 16 dict.Add "7", 17 dict.Add "8", 18 dict.Add 9, dict2 Debug.Print Dump(dict) Dim lst As New Collection lst.Add 5, "6" Dim lst2 As New Collection lst2.Add 10, "11" lst2.Add dict, "12" lst.Add lst2 Debug.Print Dump(lst) End Sub
実行結果はこちらです。
Dictionary("7":17%, "8":18%, 9%:Dictionary("5":15%, "6":16%)) Collection(5%, Collection(10%, Dictionary("7":17%, "8":18%, 9%:Dictionary("5":15%, "6":16%))))
キーの重複はNGなのにキーの存在の確認方法無いのっておかしくない?