vbs dictionary excel

读取连个e3文件 

输出格式 

blockname 1.e3s 2.e3s

aaa            Y     N

bbb          N    Y

 ccc     N         N

Dim sdict 'As Disctionary 

Dim i     'As Integer
Dim keys   'As String


Call GetInfo(sdict)
   
Set   ExcelApp  =  CreateObject("Excel.Application")        
Set   ExcelBook =  ExcelApp.Workbooks.Add  
Set   ExcelSheet   =   ExcelBook.Worksheets(1)     'ｓｈｅｅｔを追加
   
ExcelSheet.Activate   
ExcelApp.DisplayAlerts   =   False   
ExcelSheet.Name="sheet1"


ExcelSheet.range("A1").Value = "blockname"
ExcelSheet.range("B1").value="1.e3s"
ExcelSheet.range("C1").value="2.e3s"


'すべてのキーを取得
keys = sdict.Keys
'すべてのちを取得
items =sdict.Items




For i = 0 To sdict.Count - 1
ExcelSheet.cells(i+2,1).value=keys(i)
msgbox items(i)
If  items(i) = 0 Then
ExcelSheet.cells(i+2,2).value="Y"
ExcelSheet.cells(i+2,3).value="Y"
ElseIf items(i) =1 Then 
ExcelSheet.cells(i+2,2).value="Y"
ExcelSheet.cells(i+2,3).value="N"
ElseIf items(i)=2   Then
ExcelSheet.cells(i+2,2).value="N"
ExcelSheet.cells(i+2,3).value="Y"
End If
Next


ExcelBook.SaveAs "d:\1.xlsx"
ExcelBook.close


Set excelApp=nothing
Set ExcelBook=nothing
Set ExcelSheet=nothing




Public Function GetInfo(sdict)
   
Dim strarry1(5)  'As Array
Dim strarry2(8)  'As Array
Dim Count1       'As Integer
Dim Count2       'As Integer
Dim i            'As Integer


'1.e3sを読み込む
Call ReadFile("d:\3.e3s",strarry1)
'2.e3sを読み込む
Call ReadFile("d:\4.e3s",strarry2)


Count1 = ubound(strarry1)+1


Count2 = ubound(strarry2)+1

Set sdict=CreateObject("Scripting.Dictionary")


'１．ｅ３ｓのみ存在する時に、１を設定します
For i = 0 To Count1 - 1

     If strarry1(i)<>null Then
sdict.add strarry1(i),1
 
    End If 
Next


For i = 0 To Count2 - 1


'１．ｅ３ｓと２．ｅ３ｓに存在する時に、０を設定します
If sdict.Exists(strarry2(i)) Then
  If strarry2(i)<>null Then
sdict.add strarry2(i),0
            End If  
'２．ｅ３ｓのみ存在する時に、２を設定します
Else
sdict.add strarry2(i),2
End If
Next
End Function

Public Function ReadFile(filePath,strarry)


    Dim e3 'As CT.Application
Dim prj  'As CT.Job
Dim dev   'As CT.Device
Dim devides  'As string
   
    Set e3 = CreateObject( "CT.Application" )
    Set prj = e3.CreateJobObject
   
    prj.open filePath


    Set dev = Prj.CreateDeviceObject


    'devicenameを出力
    'e3.putinfo 0,"name:devides"
    devides = prj.GetAllDeviceIds(devideids)

    For i = 0 To devides
    dev.setid devideids(i)
  
        str= dev.getname 
        strarry(i)=str
  
    Next
End Function