麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
Sub EX()
Dim S, xF As Object, i As Integer, ii As Integer, Ar, A, xA() As Variant
S = Dir(ThisWorkbook.Path & "\log\*.CSV") ' **** 修改為正確路徑 ****
A = Split("產品批號,開始時間,結束時間,Robot ID,ARM,產品號碼", ",") '陣列:搜尋結果的標頭
ReDim Preserve xA(0 To ii) '重新宣告陣列的上限索引值
'Preserve (關鍵字) 保留陣列原有元素的值
xA(ii) = A
ii = i + 1
ReDim A(1 To 6)
Do While S <> ""
Set xF = GetObject(ThisWorkbook.Path & "\log\" & S)
With ThisWorkbook.Sheets(1) '這程式碼所在活頁簿的第一個工作表
If InStr(xF.Sheets(1).[C5], .[C5]) = 1 Then 'Sheets(1)
A(2) = xF.Sheets(1).[C2] '開始時間
A(3) = xF.Sheets(1).[C6] '結束時間
A(4) = Split(xF.Sheets(1).[C3], ":")(1) 'Robot ID 陣列(1)的值: 字串中以":"分割
A(5) = .[C5] 'ARM
Ar = Split(S, ".00-") '陣列: 字串中以".00-"分割
If UBound(Ar) = 1 Then
A(1) = Ar(0) '產品批號
S = Split(Split(Ar(1), "_")(0), "-")(1)
'Split(Ar(1), "_")(0) -> 分割後的字串陣列的索引值=0的元素值
If Mid(S, 1, 1) = "N" Then
S = "Null"
Else
S = Mid(S, 2)
End If
A(6) = "'" & S '產品號碼
ReDim Preserve xA(0 To ii)
xA(ii) = A
ii = ii + 1
ElseIf UBound(Ar) = 2 Then 'E1Q882.00-E1Q901.00-J07-K01_d3-h3-t18.csv
For i = 0 To 1
A(1) = Ar(i) '產品批號
S = Split(Split(Ar(2), "_")(0), "-")(i)
If Mid(S, 1, 1) = "N" Then
S = "Null"
Else
S = Mid(S, 2)
End If
A(6) = "'" & S '產品號碼
ReDim Preserve xA(0 To ii)
xA(ii) = A
ii = ii + 1
Next
End If
End If
End With
xF.Close
S = Dir
Loop
With Sheets.Add(, Sheets(1))
'.Name = "搜尋結果"
.[a1].Resize(ii, 6) = Application.Transpose(Application.Transpose(xA))
End With
End Sub

複製代碼