変更履歴
20190212 第一
20190223 第二版VBSCRIPT Propety Get により Dictionaryを配列としてクラスから取得。CSVファイルをいったんテキストで保存してBOMを付加してからCSV形式に変更することで、UTF-8BOM付きCSVファイルを作成に
参照設定なしで動きます
注意点
CSVファイルはConstで指定され、同名のファイルは削除されます
Dictinary を ADODB.Recordset または System.Collection.ArrayListでSortしてCsvファイルで出力するのは固定です。環境で変えてください。また既存のファイルは削除します。たいして需要もないので、固定にしました。
CSVファイルはUTF-8形式で改行はvbCrLfです
ADODB.Streamの開き方が固定のため、そうなります。
完全一致(Binary)でKeyが作成されます
oDic.CompareMode = 0 ' Const BinaryCompare = 0 '完全一致
この場合 Itemとitemは別のものとして扱います。
CSV、Itemでのソートは失敗するときがあります
ItemはApplication Object Arrayが入るため、そうしたテキストにならないものはエラーで処理が止まります。
Sortは期待通りにならない場合があります
文字列型で判定するため、期待通りSortされないケースがあります。
Option Base 0,Option Compare Binary
配列は0から始まることを明示しました。なおAccessの場合はOption Compare Binaryは不要です
ArrayListはMicrosoftが新規開発に使うなと言っている件（と言って現在でも１０年はたっている)
We don't recommend that you use the ArrayList class for new development. Instead, we recommend that you use the generic List class. The ArrayList class is designed to hold heterogeneous collections of objects. However, it does not always offer the best performance. Instead, we recommend the following:
For a heterogeneous collection of objects, use the List (in C#) or List(Of Object) (in Visual Basic) type.
For a homogeneous collection of objects, use the List class.
See Performance Considerations in the List reference topic for a discussion of the relative performance of these classes. See Non-generic collections shouldn't be used on GitHub for general information on the use of generic instead of non-generic collection types.
そんなことを言ってもVBAにはないし、13年前からそういっているというのはどうなの?
https://oshiete.goo.ne.jp/qa/5051550.html
No.1ベストアンサー
回答者： Wizard_Zero 回答日時：2009/06/17 17:45
ここで説明できる分量ではないので、下記のサイトを参考にしてください。
https://www.atmarkit.co.jp/ait/articles/0602/11/news011.html
この回答へのお礼
ありがとうございます。
ジェネリックは、コレクションに使われる。
ジェネリックコレクションには、ジェネリッククラスとジェネリックメソッドが定義されている。
ジェネリックコレクションは、リストと同じように、配列と違いどんな型でも代入できる。
しかし、ジェネリックコレクションは、リストと違い<>やList(Of ...) などで型を制限できて、Exceptionさせることができる。
ArrayListクラスはSystem.Collections名前空間に分類されているクラスでジェネリックでないので、今後利用する機会は減っていく
なるほど。
コレクションやリストのときにジェネリックを使うのですね。
クリップボードの履歴を蓄積するソフトを作ってみたいです。
お礼日時：2009/06/18 18:25
従来のコレクションの代表：ArrayListクラス
まずは、.NET Framework 1.xで最もよく使用されたコレクションであろうで「ArrayListクラス」について簡単に振り返ってみます。
ArrayListクラスはSystem.Collections名前空間に分類されているクラスです。今後利用する機会は減っていくと思われますが、.NET Framework 2.0でももちろんArrayListクラスは利用可能です。
clsDictionary Funciton List
| Sub/Function Name | 機能 |
|---|---|
| Class_Initialize | 初期化してDictionaryを作成する。参照設定をした場合はコメント部分と変える |
| Chekfile | csvファイルを出力するとき、既存のものは削除する |
| getAddkey | Keyがなければ追加する |
| isKeyExist | KeyがあるかBoolean形式で返す |
| getDelKey | Keyを削除する |
| DicItemCount | Keyがいくつあるか |
| listKeies | Keyの一覧をイミディエイトに出力(ただしオブジェクトは不可) |
| listItems | Itemの一覧をイミディエイトに出力(ただしオブジェクトは不可) |
| retKeyitem | 指定したKeyに対するItemを返す Variant |
| retKeyWord | Item（キーの値）から検索する、重複してもリストをだす(ただしオブジェクトは不可) |
| ReplaseItem | Keyの値の置き換え, 成功したらtrueを返す |
| arOpenRecord | ADODB.Recordsetを開く |
| srOpenStream | ADODB.Streamを開く。UTF-8形式 |
| ExportCSVAr | ADODB.Recordsetで昇順SortしてCSVを作成(ただしオブジェクトは不可) |
| ExportCSVAr_Rev | ADODB.Recordsetで降順ソートをしてCSVを作成(ただしオブジェクトは不可) |
| ExporItemSOrtCSVAL | ArrayListでItemをSortしてCSVを作成(ただしオブジェクトは不可) |
| ExporCSVAL_REV | ArrayListでKeyを降順ソートしてCSVを作成(ただしオブジェクトは不可) |
| ExporCSVAL | ArrayListでKeyをソートしてCSVを作成(ただしオブジェクトは不可) |
| DicKeys [Public Property Get] | DictionaryのKeysの配列を返す。その性質上、重複は存在しない |
| DicItems [Public Property Get] | DictionaryのItemsの配列を返す。その性質上、重複は存在しうる |
Class Module クラスモジュール
Option Explicit
Option Base 0
Option Compare Binary
'Class Name = clsDictionary
' Ver 20199212>20190223
' Enum 定数 参照設定した場合はコメントアウトしてください
'参照設定(参考)
#If Win64 Then
Const arraylistfile = "C:\Windows\Microsoft.NET\Framework64\v4.0.30319\mscorlib.tlb" ' Microsoft Common Language Runtime Class Library
#Else
Const arraylistfile = "C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb" ' Microsoft Common Language Runtime Class Library
#End If
' Export File fullPath '各自で決定してください。ただし末尾にtがついている方がtxtファイルです。UTF-8Textで保存し、csvに変えます。既存のファイルは削除されます。
Const ListFileAl = "D:\ListU8Al.csv", ListFileAlt = "D:\ListU8Al.txt"
Const ListFileAl_Rev = "D:\ListU8Al_Rev.csv", ListFileAl_Revt = "D:\ListU8Al_Rev.txt"
Const listfileAr = "D:\listU8Ar.csv", listfileArt = "D:\listU8Ar.txt"
Const listfileAr_Rev = "D:\listU8Ar_Ref.csv", listfileAr_Revt = "D:\listU8Ar_Ref.txt"
Const ItemSorfFileAL = "D:\ItemSortU8AL.csv", ItemSorfFileALt = "D:\ItemSortU8AL.txt"
Const adWriteLine = 1
Const adSaveCreateNotExist = 1
Const adUseClient = 3
Const adOpenStatic = 3
Const adCRLF = -1
Const adModeReadWrite = 3
Const adTypeText = 2
' 参照設定しているときは 'As を As にかえてください
Dim oDic 'As Scripting.Dictionary
Dim sr 'As ADODB.Stream
Dim ar 'As ADODB.Recordset
Dim FSO 'As Scripting.FileSystemObject
Dim aL 'As ArrayList
Dim varKey, varItm
' /// Class 初期化
Private Sub Class_Initialize()
'Set oDic = New Scripting.Dictionary
'Set sr = New ADODB.Stream
'Set ar = New ADODB.Recordset
'Set FSO = New Scripting.FileSystemObject
'Set aL = New ArrayList
Set oDic = CreateObject("Scripting.Dictionary")
Set ar = CreateObject("ADODB.Recordset")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set aL = CreateObject("System.Collections.ArrayList")
oDic.CompareMode = 0 ' Const BinaryCompare = 0 '完全一致<<重要/Important>>Arraylist Sort Method Property Perfect Match
End Sub
' /// Export File Check
Private Sub Chekfile(strChekfile)
'保存するファイル名があれば削除する
If FSO.FileExists(strChekfile) Then FSO.DeleteFile strChekfile, True
End Sub
Function getAddkey(wordofkey, valueOfkey)
'Keyの追加
If oDic.Exists(wordofkey) = False Then oDic.Add wordofkey, valueOfkey: getAddkey = True Else getAddkey = False
End Function
'[|:-------------------------------------------:|]
Function isKeyExist(wordofkey) As Boolean
'キーの存在
isKeyExist = oDic.Exists(wordofkey)
End Function
Function getDelKey(wordofkey)
'削除
If Not oDic Is Nothing Then
If oDic.Exists(wordofkey) = True Then
oDic.Remove (wordofkey)
getDelKey = True
Exit Function
Else
getDelKey = False
End If
End If
End Function
'[|:-------------------------------------------:|]
Function DicItemCount() As Long
'Itemのカウント
If Not oDic Is Nothing Then DicItemCount = oDic.Count Else DicItemCount = 0
End Function
Function listKeies()
'Keyの一覧をImmediateに出力
Dim i As Long
If oDic Is Nothing Then listKeies = False: Exit Function
On Error Resume Next
For i = 0 To oDic.Count - 1
Debug.Print oDic.Keys(i)
If Err.Number <> 0 Then listKeies = False: Exit Function
Next
listKeies = True
Exit Function
End Function
' /// Sort / Reverse And Export
'[|:-------------------------------------------:|]
Sub ExporItemSOrtCSVAL()
'ItemでソートしてCSVで返す
Dim arr, brr
Dim i As Long, j As Long
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.items
For i = LBound(arr) To UBound(brr)
On Error Resume Next
aL.Add brr(i)
If Err.Number <> 0 Then Debug.Print Err.Number: Exit Sub
Next
aL.Sort
Call srOpenStream
For i = 0 To aL.Count - 1
For j = LBound(arr) To UBound(arr)
If oDic.Item(arr(j)) = aL(i) Then
On Error Resume Next
sr.WriteText Chr(34) & arr(j) & Chr(34) & "," & Chr(34) & aL(i) & Chr(34), adWriteLine
If Err.Number <> 0 Then Debug.Print "ExporItemSOrtCSVAL Line 17 Error Occue", Err.Number, Err.Description: Exit Sub
Exit For
End If
Next
Next
Call Chekfile(ItemSorfFileAL)
sr.SaveToFile ItemSorfFileAL, adSaveCreateNotExist
sr.Close
ar.Close
End Sub
'[|:-------------------------------------------:|]
Sub ExporCSVAL_REV()
'ArraylistでリバースしてCSV
Dim arr, brr
Dim i As Long
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.items
For i = LBound(arr) To UBound(arr)
aL.Add arr(i)
Next
aL.Sort
aL.Reverse
srOpenStream
For i = LBound(arr) To UBound(arr)
sr.WriteText Chr(34) & aL.Item(i) & Chr(34) & "," & Chr(34) & oDic.Item(aL(i)) & Chr(34), adWriteLine
Next
Call Chekfile(ListFileAl_Rev): Call Chekfile(ListFileAl_Revt)
sr.SaveToFile ListFileAl_Revt: FSO.movefile ListFileAl_Revt, ListFileAl_Rev
sr.Close
aL.Clear
End Sub
'[|:-------------------------------------------:|]
Sub ExporCSVAL()
'ArrayListでソートしてCSV出力
Dim arr, brr
Dim i As Long
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.items
For i = LBound(arr) To UBound(arr)
aL.Add arr(i)
Next
aL.Sort
srOpenStream
For i = LBound(arr) To UBound(arr)
sr.WriteText Chr(34) & aL.Item(i) & Chr(34) & "," & Chr(34) & oDic.Item(aL(i)) & Chr(34), adWriteLine
Next
Call Chekfile(ListFileAl): Call Chekfile(ListFileAlt)
sr.SaveToFile ListFileAlt: FSO.movefile ListFileAlt, ListFileAl
sr.Close
aL.Clear
End Sub
'[|:-------------------------------------------:|]
Function listItems()
'Itemの一覧をimmidiateに出力
'データタイプがオブジェクトなどの場合エラーを出してFalseが返る
'データタイプを確認できる
If oDic Is Nothing Then listItems = False: Exit Function
For Each varKey In oDic.Keys
On Error Resume Next
Debug.Print oDic.Item(varKey), TypeName(oDic.Item(varKey))
If Err.Number <> 0 Then Debug.Print " listItems Datatype Cannot output immediate ", Err.Number, Err.Description: listItems = False: Exit Function
Next
End Function
'[|:-------------------------------------------:|]
Function retKeyitem(wordofkey)
'Keyに対する値を返す
If oDic Is Nothing Then retKeyitem = "": Exit Function
If oDic.Exists(wordofkey) Then
On Error Resume Next
retKeyitem = oDic.Item(wordofkey)
If Err.Number <> 0 Then Set retKeyitem = oDic.Item(wordofkey)
Exit Function
End If
End Function
'[|:-------------------------------------------:|]
Function retKeyWord(valueOfkey)
'Item（キーの値）から検索する、重複してもリストをだす
Dim arr, brr
Dim i As Long
Dim buf As String
Dim i1 As Long
If oDic Is Nothing Then Exit Function
brr = oDic.items
arr = oDic.Keys
On Error Resume Next
i1 = 1
For i = LBound(arr) To UBound(arr)
If oDic.Item(arr(i)) = valueOfkey Then
If i1 = 1 Then
buf = arr(i)
i1 = i1 + 1
Else
buf = buf & "," & arr(i)
i1 = i1 + 1
End If
If Err.Number <> 0 Then Debug.Print "retkeyWord Error ", Err.Number, Err.Description: Exit Function
End If
Next
retKeyWord = "items.count = " & i1 & vbCrLf & "Key List :" & buf
End Function
'[|:-------------------------------------------:|]
Function ReplaseItem(wordofkey, valueOfkey)
'Keyの値の置き換え, 成功したらtrueを返す
If oDic Is Nothing Then ReplaseItem = False: Exit Function
If oDic.Exists(wordofkey) = False Then ReplaseItem = False: Exit Function
oDic.Item(wordofkey) = valueOfkey
ReplaseItem = True
End Function
Public Property Get DicKeys()
DicKeys = oDic.Keys
End Property
Public Property Get DicItems()
DicItems = oDic.items
End Property
Private Sub arOpenRecord()
'adodb.recordsetのイニシャライズ
If Not ar Is Nothing Then Set ar = Nothing
'Set ar = New ADODB.Recordset
Set ar = CreateObject("ADODB.Recordset")
ar.Fields.Append "F00Key", 200, 255 ' Const adVarChar = 200
ar.Fields.Append "F01Itm", 200, 255
ar.CursorLocation = adUseClient
ar.CursorType = adOpenStatic
ar.Open
End Sub
Private Function srOpenStream()
'adodb.Streamのイニシャライズ
On Error Resume Next
If Not sr Is Nothing Then Set sr = Nothing
On Error GoTo 0
If Err.Number <> 0 Then Err.Clear
'Set ar = New ADODB.Recordset
Set sr = CreateObject("ADODB.Stream")
sr.Charset = "utf-8"
sr.LineSeparator = -1 ' adCRLF = -1
sr.Mode = 3 'Const adModeReadWrite = 3
sr.Type = 2 'Const adTypeText = 2
sr.Open
End Function
'[|:-------------------------------------------:|]
Sub ExportCSVAr()
' adodb.recordsetで昇順ソートしてcsvに出力、できない場合エラー
Dim arr, brr
Dim i As Long
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.items
Call arOpenRecord
For i = LBound(arr) To UBound(brr)
On Error Resume Next
ar.AddNew
ar(0) = arr(i)
ar(1) = brr(i)
ar.Update
If Err.Number <> 0 Then Exit Sub
Next
ar.Sort = ar.Fields(0).Name
srOpenStream
ar.MoveFirst
Do Until ar.EOF = True
On Error Resume Next
sr.WriteText Chr(34) & ar(0) & Chr(34) & "," & Chr(34) & ar(1) & Chr(34), adWriteLine
If Err.Number <> 0 Then Exit Sub
ar.MoveNext
Loop
Call Chekfile(listfileAr): Call Chekfile(listfileArt)
sr.SaveToFile listfileArt: FSO.movefile listfileArt, listfileAr
sr.Close
ar.Close
End Sub
'[|:-------------------------------------------:|]
Sub ExportCSVAr_Rev()
' adodb.recordsetでリバースしてcsvに出力、できない場合エラー
Dim arr, brr
Dim i As Long
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.items
Call arOpenRecord
For i = LBound(arr) To UBound(brr)
On Error Resume Next
ar.AddNew
ar(0) = arr(i)
ar(1) = brr(i)
ar.Update
If Err.Number <> 0 Then Exit Sub
Next
ar.Sort = ar.Fields(0).Name & " DESC"
Call srOpenStream
ar.MoveFirst
Do Until ar.EOF = True
On Error Resume Next
sr.WriteText Chr(34) & ar(0) & Chr(34) & "," & Chr(34) & ar(1) & Chr(34), adWriteLine
If Err.Number <> 0 Then Exit Sub
ar.MoveNext
Loop
Call Chekfile(listfileAr_Revt): Call Chekfile(listfileAr_Rev)
sr.SaveToFile listfileAr_Revt
FSO.movefile listfileAr_Revt, listfileAr_Rev
sr.Close
ar.Close
End Sub
'[|:-------------------------------------------:|]
Private Sub Class_Terminate()
If Not oDic Is Nothing Then oDic.Removeall: Set oDic = Nothing
If Not ar Is Nothing Then Set ar = Nothing
If Not sr Is Nothing Then Set sr = Nothing
If Not aL Is Nothing Then Set aL = Nothing
End Sub
標準モジュール
Sub ClassScriptingDictionarytest()
'Ver20190223
Dim cDic As clsDictionary
Dim ALKeys, ALItems
Dim arDicKeys, arDicItems
Set cDic = New clsDictionary
cDic.getAddkey "India", "インド"
cDic.getAddkey "USA", "アメリカ"
cDic.getAddkey "America", "アメリカ"
cDic.getAddkey "England", "イギリス"
cDic.getAddkey "Japan", "日本"
Debug.Print cDic.DicItemCount
Debug.Print cDic.retKeyitem("USA")
cDic.ReplaseItem "Japan", "ニッポン"
Debug.Print cDic.retKeyWord("アメリカ")
Debug.Print cDic.listItems
Debug.Print cDic.listKeies
cDic.ExportCSVAr
cDic.ExporCSVAL
cDic.ExporCSVAL_REV
cDic.ExportCSVAr_Rev
cDic.isKeyExist "Japan"
'配列として取得
arDicKeys = cDic.DicKeys: Debug.Print "arDicKeys ", UBound(arDicKeys)
arDicItems = cDic.DicItems: Debug.Print "arDicItems ", UBound(arDicItems)
cDic.ExportCSVAr 'ADODB.RecordsetでSortした結果
cDic.ExporCSVAL 'Arraylist で Sortした結果(こちらは完全一致)
cDic.ExporCSVAL_REV 'Arraylist Reverce 降順Sortした結果(こちらは完全一致)
cDic.ExportCSVAr_Rev 'ADODB.recordset でDESCにより降順ソートした結果
cDic.ExporItemSOrtCSVAL 'ArrayListのKeyではなくItemでSortした結果
End Sub
VBscript版
Option Explicit
'Class Name = clsDictionary
' Ver 20199212>20190223
' Enum 定数
Const adWriteLine = 1
Const adSaveCreateNotExist = 1
Const adUseClient = 3
Const adOpenStatic = 3
Const adCRLF = -1
Const adModeReadWrite = 3
Const adTypeText = 2
' Export File fullPath
Const ListFileAl = "D:\ListU8Al.csv" , ListFileAlt = "D:\ListU8Al.txt"
Const ListFileAl_Rev = "D:\ListU8Al_Rev.csv", ListFileAl_Revt = "D:\ListU8Al_Rev.txt"
Const listfileAr = "D:\listU8Ar.csv",listfileArt = "D:\listU8Ar.txt"
Const listfileAr_Rev = "D:\listU8Ar_Ref.csv", listfileAr_Revt = "D:\listU8Ar_Ref.txt"
Const ItemSorfFileAL = "D:\ItemSortU8AL.csv", ItemSorfFileALt = "D:\ItemSortU8AL.txt"
Class clsDictionary
Dim oDic 'As Scripting.Dictionary
Dim sr 'As ADODB.Stream
Dim ar 'As ADODB.Recordset
Dim FSO 'As Scripting.FileSystemObject
Dim aL 'As ArrayList
Dim varKey, varItm
' /// Class 初期化
Private Sub Class_Initialize()
Set oDic = CreateObject("Scripting.Dictionary")
Set ar = CreateObject("ADODB.Recordset")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set aL = CreateObject("System.Collections.ArrayList")
oDic.CompareMode = 0 ' Const BinaryCompare = 0 '完全一致
End Sub
' /// Export File Check
Private Sub Chekfile(strChekfile)
'保存するファイル名があれば削除する
If FSO.FileExists(strChekfile) Then FSO.DeleteFile strChekfile, True
End Sub
Function getAddkey(wordofkey, valueOfkey)
'Keyの追加
If oDic.Exists(wordofkey) = False Then oDic.Add wordofkey, valueOfkey: getAddkey = True Else getAddkey = False
End Function
'[|:-------------- VBScript clsDitionary ---------------------:|]
Function isKeyExist(wordofkey) 'As Boolean
'キーの存在
isKeyExist = oDic.Exists(wordofkey)
End Function
Function getDelKey(wordofkey)
'削除
If Not oDic Is Nothing Then
If oDic.Exists(wordofkey) = True Then
oDic.Remove (wordofkey)
getDelKey = True
Exit Function
Else
getDelKey = False
End If
End If
End Function
'[|:-------------- VBScript clsDitionary ---------------------:|]
Function DicItemCount() 'AsLong
'Itemのカウント
If Not oDic Is Nothing Then DicItemCount = oDic.Count Else DicItemCount = 0
End Function
Function listKeies()
'Keyの一覧をImmediateに出力
Dim i 'AsLong
If oDic Is Nothing Then listKeies = False: Exit Function
On Error Resume Next
For i = 0 To oDic.Count - 1
Wscript.Echo oDic.Keys(i)
If Err.Number <> 0 Then listKeies = False: Exit Function
Next
listKeies = True
Exit Function
End Function
' /// Sort / Reverse And Export
'[|:-------------- VBScript clsDitionary ---------------------:|]
Sub ExporItemSOrtCSVAL()
'ItemでソートしてCSVで返す
Dim arr, brr
Dim i , j
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.Items
For i = LBound(arr) To UBound(brr)
'On Error Resume Next
aL.Add brr(i)
If Err.Number <> 0 Then Wscript.Echo Err.Number: Exit Sub
Next
aL.Sort
Call srOpenStream
For i = 0 To aL.Count - 1
For j = LBound(arr) To UBound(arr)
If oDic.Item(arr(j)) = aL(i) Then
On Error Resume Next
sr.WriteText Chr(34) & arr(j) & Chr(34) & "," & Chr(34) & aL(i) & Chr(34), adWriteLine
If Err.Number <> 0 Then Wscript.Echo "ExporItemSOrtCSVAL Line 17 Error Occue", Err.Number, Err.Description: Exit Sub
Exit For
End If
Next
Next
Call Chekfile(ItemSorfFileAL) :Call Chekfile(ItemSorfFileALt)
sr.SaveToFile ItemSorfFileALt
FSO.movefile ItemSorfFileALt, ItemSorfFileAL
sr.Close
ar.Close
End Sub
'[|:-------------- VBScript clsDitionary ---------------------:|]
Sub ExporCSVAL_REV()
'ArraylistでリバースしてCSV
Dim arr, brr
Dim i 'AsLong
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.Items
For i = LBound(arr) To UBound(arr)
aL.Add arr(i)
Next
aL.Sort
aL.Reverse
srOpenStream
For i = LBound(arr) To UBound(arr)
sr.WriteText Chr(34) & aL.Item(i) & Chr(34) & "," & Chr(34) & oDic.Item(aL(i)) & Chr(34), adWriteLine
Next
Call Chekfile(ListFileAl_Rev) :Call Chekfile(ListFileAl_Revt)
sr.SaveToFile ListFileAl_Revt : Fso.Movefile ListFileAl_Revt,ListFileAl_Rev
sr.Close
aL.Clear
End Sub
'[|:-------------- VBScript clsDitionary ---------------------:|]
Sub ExporCSVAL()
'ArrayListでソートしてCSV出力
Dim arr, brr
Dim i 'AsLong
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.Items
For i = LBound(arr) To UBound(arr)
aL.Add arr(i)
Next
aL.Sort
srOpenStream
For i = LBound(arr) To UBound(arr)
sr.WriteText Chr(34) & aL.Item(i) & Chr(34) & "," & Chr(34) & oDic.Item(aL(i)) & Chr(34), adWriteLine
Next
Call Chekfile(ListFileAl) : Call Chekfile(ListFileAlt)
sr.SaveToFile ListFileAlt : Fso.movefile ListFileAlt, ListFileAl
sr.Close
aL.Clear
End Sub
'[|:-------------- VBScript clsDitionary ---------------------:|]
Function listItems()
'Itemの一覧をimmidiateに出力
'データタイプがオブジェクトなどの場合エラーを出してFalseが返る
'データタイプを確認できる
If oDic Is Nothing Then listItems = False: Exit Function
For Each varKey In oDic.Keys
On Error Resume Next
Wscript.Echo oDic.Item(varKey), TypeName(oDic.Item(varKey))
If Err.Number <> 0 Then Wscript.Echo " listItems Datatype Cannot output immediate ", Err.Number, Err.Description: listItems = False: Exit Function
Next
End Function
'[|:-------------- VBScript clsDitionary ---------------------:|]
Function retKeyitem(wordofkey)
'Keyに対する値を返す
If oDic Is Nothing Then retKeyitem = "": Exit Function
If oDic.Exists(wordofkey) Then
On Error Resume Next
retKeyitem = oDic.Item(wordofkey)
If Err.Number <> 0 Then Set retKeyitem = oDic.Item(wordofkey)
Exit Function
End If
End Function
'[|:-------------- VBScript clsDitionary ---------------------:|]
Function retKeyWord(valueOfkey)
'Item（キーの値）から検索する、重複してもリストをだす
Dim arr, brr
Dim i 'AsLong
Dim buf 'AsString
Dim i1 'AsLong
If oDic Is Nothing Then Exit Function
brr = oDic.Items
arr = oDic.Keys
On Error Resume Next
i1 = 1
For i = LBound(arr) To UBound(arr)
If oDic.Item(arr(i)) = valueOfkey Then
If i1 = 1 Then
buf = arr(i)
i1 = i1 + 1
Else
buf = buf & "," & arr(i)
i1 = i1 + 1
End If
If Err.Number <> 0 Then Wscript.Echo "retkeyWord Error ", Err.Number, Err.Description: Exit Function
End If
Next
retKeyWord = "items.count = " & i1 & vbCrLf & "Key List :" & buf
End Function
'[|:-------------- VBScript clsDitionary ---------------------:|]
Function ReplaseItem(wordofkey, valueOfkey)
'Keyの値の置き換え, 成功したらtrueを返す
If oDic Is Nothing Then ReplaseItem = False: Exit Function
If oDic.Exists(wordofkey) = False Then ReplaseItem = False: Exit Function
oDic.Item(wordofkey) = valueOfkey
ReplaseItem = True
End Function
'[|:-------------- VBScript clsDitionary ---------------------:|]
' Dictionary Object を配列として取り出す。
' このためにProperty Getを用いる。
Public Property Get DicKeys()
DicKeys = oDic.Keys
End Property
'[|:-------------- VBScript clsDitionary ---------------------:|]
Public Property Get DicItems()
DicItems = oDic.items
End Property
'[|:-------------- VBScript clsDitionary ---------------------:|]
' 取り出したデータを保存する
Private Sub arOpenRecord()
'adodb.recordsetのイニシャライズ
If Not ar Is Nothing Then Set ar = Nothing
'Set ar = New ADODB.Recordset
Set ar = CreateObject("ADODB.Recordset")
ar.Fields.Append "F00Key", 200, 255 ' Const adVarChar = 200
ar.Fields.Append "F01Itm", 200, 255
ar.CursorLocation = adUseClient
ar.CursorType = adOpenStatic
ar.Open
End Sub
'[|:-------------- VBScript clsDitionary ---------------------:|]
Private Function srOpenStream()
'adodb.Streamのイニシャライズ
On Error Resume Next
If Not sr Is Nothing Then Set sr = Nothing
On Error GoTo 0
If Err.Number <> 0 Then Err.Clear
'Set ar = New ADODB.Recordset
Set sr = CreateObject("ADODB.Stream")
sr.Charset = "utf-8"
sr.LineSeparator = -1 ' adCRLF = -1
sr.Mode = 3 'Const adModeReadWrite = 3
sr.Type = 2 'Const adTypeText = 2
sr.Open
End Function
'[|:-------------- VBScript clsDitionary ---------------------:|]
Sub ExportCSVAr()
' adodb.recordsetで昇順ソートしてcsvに出力、できない場合エラー
Dim arr, brr
Dim i 'AsLong
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.Items
Call arOpenRecord
For i = LBound(arr) To UBound(brr)
On Error Resume Next
ar.AddNew
ar(0) = arr(i)
ar(1) = brr(i)
ar.Update
If Err.Number <> 0 Then Exit Sub
Next
ar.Sort = ar.Fields(0).Name
srOpenStream
ar.MoveFirst
Do Until ar.EOF = True
On Error Resume Next
sr.WriteText Chr(34) & ar(0) & Chr(34) & "," & Chr(34) & ar(1) & Chr(34), adWriteLine
If Err.Number <> 0 Then Exit Sub
ar.MoveNext
Loop
Call Chekfile(listfileAr) : Call Chekfile(listfileArt)
sr.SaveToFile listfileArt : Fso.movefile listfileArt, listfileAr
sr.Close
ar.Close
End Sub
'[|:-------------- VBScript clsDitionary ---------------------:|]
Sub ExportCSVAr_Rev()
' adodb.recordsetでリバースしてcsvに出力、できない場合エラー
Dim arr, brr
Dim i 'As Long
If oDic Is Nothing Then Exit Sub
arr = oDic.Keys: brr = oDic.Items
Call arOpenRecord
For i = LBound(arr) To UBound(brr)
On Error Resume Next
ar.AddNew
ar(0) = arr(i)
ar(1) = brr(i)
ar.Update
If Err.Number <> 0 Then Exit Sub
Next
ar.Sort = ar.Fields(0).Name & " DESC"
Call srOpenStream
ar.MoveFirst
Do Until ar.EOF = True
On Error Resume Next
sr.WriteText Chr(34) & ar(0) & Chr(34) & "," & Chr(34) & ar(1) & Chr(34), adWriteLine
If Err.Number <> 0 Then Exit Sub
ar.MoveNext
Loop
Call Chekfile(listfileAr_Revt) : Call Chekfile(listfileAr_Rev)
sr.SaveToFile listfileAr_Revt
Fso.movefile listfileAr_Revt,listfileAr_Rev
sr.Close
ar.Close
End Sub
'[|:-------------- VBScript clsDitionary ---------------------:|]
' Class 終了処理 Terminate
Private Sub Class_Terminate()
If Not oDic Is Nothing Then oDic.RemoveAll: Set oDic = Nothing
If Not ar Is Nothing Then Set ar = Nothing
If Not sr Is Nothing Then Set sr = Nothing
If Not aL Is Nothing Then Set aL = Nothing
End Sub
End Class
'[|:-------------- VBScript clsDitionary ---------------------:|]
Dim cDic 'AsclsDictionary
Dim arDicKeys, arDicItems
Set cDic = New clsDictionary
cDic.getAddkey "India", "インド"
cDic.getAddkey "USA", "アメリカ"
cDic.getAddkey "America", "アメリカ"
cDic.getAddkey "England", "イギリス"
cDic.getAddkey "Japan", "日本"
Wscript.Echo cDic.DicItemCount
Wscript.Echo cDic.retKeyitem("USA")
cDic.ReplaseItem "Japan", "ニッポン"
Wscript.Echo cDic.retKeyWord("アメリカ")
Wscript.Echo cDic.listItems
Wscript.Echo cDic.listKeies
cDic.ExportCSVAr 'ADODB.RecordsetでSortした結果。CSVのコードはUTF-8 以下同じ
cDic.ExporCSVAL 'Arraylist で Sortした結果(こちらは完全一致)
cDic.ExporCSVAL_REV 'Arraylist Reverce 降順Sortした結果(こちらは完全一致)
cDic.ExportCSVAr_Rev 'ADODB.recordset でDESCにより降順ソートした結果
cDic.isKeyExist "Japan"
cDic.ExporItemSOrtCSVAL 'ArrayListのKeyではなくItemでSortした結果
arDicKeys = cDic.DicKeys : Wscript.Echo "arDicKeys " , Ubound(arDicKeys)
arDicItems = cDic.DicItems : Wscript.Echo "arDicItems " , Ubound(arDicItems)
Wscript.Quit