|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
各位大神,字典可以循环使用吗?帮忙看下这是什么问题
字典第一次赋值,输出数据后,再第二次循环,就报错了
代码如下:
Sub getCT()
Dim U01Data_Num%, Combin_Num%, IP_Address$, MountMode$, Machine_Num$
Dim d
Set d = CreateObject("Scripting.Dictionary")
Combin_Num = Sheets("Combin").[a65536].End(xlUp).Row
For i = 2 To Combin_Num
If Sheets("Combin").Cells(i, 6) <> "" Then
IP_Address = Sheets("Combin").Cells(i, 2)
MountMode = Sheets("Combin").Cells(i, 6)
For j = 1 To Len(MountMode)
Machine_Num = Format(j, "00")
Call readfile(IP_Address, Machine_Num)
U01Data_Num = Sheets("U01Data").[a65536].End(xlUp).Row
For k = 1 To U01Data_Num
d.Add Sheets("U01Data").Cells(k, 1).Value, Sheets("U01Data").Cells(k, 2)
'MsgBox d(Sheets("U01Data").Cells(k, 1).Value)
'MsgBox Sheets("U01Data").Cells(k, 1)
'MsgBox Sheets("U01Data").Cells(k, 2)
Next
Sheets("Combin").Cells(i, 6 + j) = d("CTime3_T")
Set d = Nothing
Next
Else
End If
Next
End Sub
Sub readfile(IP_Address$, Machine_Num$)
Dim rLine$, s$, flag$, Datenum$, mypath$, keystring$, filename$, filepath$, line_num%, rLine_Arr
Dim d
Set d = CreateObject("Scripting.Dictionary")
Datenum = Format(Date, "yyyymmdd")
mypath = "\\" & IP_Address & "\productionreport\" & Datenum & "\"
keystring = Machine_Num & "-1-1-3"
Call filelist(mypath, keystring)
line_num = Sheets("U01file").[a65536].End(xlUp).Row
filename = Sheets("U01file").Cells(line_num, 1)
filepath = mypath & "\" & filename
Open filepath For Input As #1
'Open "D:\CT.txt" For Output As #2
Do While Not EOF(1)
Line Input #1, rLine
rLine_Arr = Split(rLine, Chr(10))
Loop
Close #1
For i = 0 To UBound(rLine_Arr)
s = rLine_Arr(i)
If InStr(s, "Index") Then
flag = "Index"
ElseIf InStr(s, "Information") Then
flag = "Information"
ElseIf InStr(s, "Time") Then
flag = "Time"
ElseIf InStr(s, "CycleTime") Then
flag = "Cycletime"
ElseIf InStr(s, "Count") Then
flag = "Count"
ElseIf InStr(s, "Dispenser") Then
flag = "Dispenser"
ElseIf InStr(s, "MountPickupFeeder") Then
flag = "MountPickupFeeder"
ElseIf InStr(s, "MountPickupNozzle") Then
flag = "MountPickupNozzle"
ElseIf InStr(s, "InspectionData") Then
flag = "InspectionData"
ElseIf InStr(s, " ") Then
flag = 0
Else
End If
If flag = "Index" And InStr(s, "[") = 0 And s <> "" Then
d(Mid(s, 1, InStr(s, "=") - 1)) = Mid(s, InStr(s, "=") + 1, Len(s))
ElseIf flag = "Information" And InStr(s, "[") = 0 And s <> "" Then
d(Mid(s, 1, InStr(s, "=") - 1)) = Mid(s, InStr(s, "=") + 1, Len(s))
ElseIf flag = "Time" And InStr(s, "[") = 0 And s <> "" Then
d(Mid(s, 1, InStr(s, "=") - 1) & "_T") = Mid(s, InStr(s, "=") + 1, Len(s))
ElseIf flag = "CycleTime" And InStr(s, "[") = 0 And s <> "" Then
d(Mid(s, 1, InStr(s, "=") - 1)) = Mid(s, InStr(s, "=") + 1, Len(s))
ElseIf flag = "Count" And InStr(s, "[") = 0 And s <> "" Then
d(Mid(s, 1, InStr(s, "=") - 1) & "_C") = Mid(s, InStr(s, "=") + 1, Len(s))
End If
Next
Sheets("U01Data").Cells.Clear
Sheets("U01Data").[A1].Resize(d.Count, 2) = Application.Transpose(Array(d.Keys, d.Items))
Set d = Nothing
'Close #2
End Sub
Sub filelist(mypath$, keystring$)
pname = mypath & "*" & keystring & "*.U01"
Set wsh = CreateObject("WScript.Shell")
Set wExec = wsh.Exec("cmd /c dir /b " & pname)
ts = Split(wExec.StdOut.ReadAll, Chr(13) & Chr(10))
Sheets("U01file").Cells.Clear
Sheets("U01file").[A1].Resize(UBound(ts)) = WorksheetFunction.Transpose(ts)
End Sub
|
|