[發問] 在不開檔情況下搜尋多數量cvs檔案內容彙整出相對應信息

lomchkimo

各位先進大家好, 我最近想用EXCEL做設備紀錄檔(.cvs)搜尋彙整的小工具
例如一台設備有兩隻機械手臂, 在不開檔的情況下根據檔案路徑中紀錄檔搜尋其中一隻機械手臂編號, 列出對應產品批號/產品號碼/時間/手臂編號並且另存新檔
但是產品批號與產品號碼在檔案名稱上, 機械手臂編號則在檔案內容中, 每批產品會有7~10份的不規則產品數量, 跪求各位先進幫忙指點迷津

下載 (14.57 KB)

2014-2-4 09:41

下載 (77.55 KB)

2014-2-4 09:41

搜尋結果中是以手臂編號Z3051進行搜索

產品追蹤.rar (9.21 KB)

下載次數: 4

2014-2-4 09:55

GBKEE

回復 1# lomchkimo
試試看

1. Option Explicit
   
2. Sub EX()
   
3.     Dim S, xF As Object, i As Integer, ii As Integer, Ar, A, xA() As Variant
   
4.     S = Dir(ThisWorkbook.Path & "\log\*.CSV")  ' **** 修改為正確路徑  ****
   
5.     A = Split("產品批號,開始時間,結束時間,Robot ID,ARM,產品號碼", ",")  '陣列:搜尋結果的標頭
   
6.     ReDim Preserve xA(0 To ii)  '重新宣告陣列的上限索引值
   
7.                                 'Preserve (關鍵字) 保留陣列原有元素的值
   
8.     xA(ii) = A
   
9.     ii = i + 1
   
10.     ReDim A(1 To 6)
    
11.     Do While S <> ""
    
12.         Set xF = GetObject(ThisWorkbook.Path & "\log\" & S)
    
13.         With ThisWorkbook.Sheets(1)                      '這程式碼所在活頁簿的第一個工作表
    
14.             If InStr(xF.Sheets(1).[C5], .[C5]) = 1 Then  'Sheets(1)
    
15.                 A(2) = xF.Sheets(1).[C2]                 '開始時間
    
16.                 A(3) = xF.Sheets(1).[C6]                 '結束時間
    
17.                 A(4) = Split(xF.Sheets(1).[C3], ":")(1)  'Robot ID  陣列(1)的值: 字串中以":"分割
    
18.                 A(5) = .[C5]                             'ARM
    
19.                 Ar = Split(S, ".00-")  '陣列: 字串中以".00-"分割
    
20.                 If UBound(Ar) = 1 Then
    
21.                     A(1) = Ar(0)                         '產品批號
    
22.                     S = Split(Split(Ar(1), "_")(0), "-")(1)
    
23.                     'Split(Ar(1), "_")(0) -> 分割後的字串陣列的索引值=0的元素值
    
24.                     If Mid(S, 1, 1) = "N" Then
    
25.                         S = "Null"
    
26.                     Else
    
27.                         S = Mid(S, 2)
    
28.                     End If
    
29.                     A(6) = "'" & S                      '產品號碼
    
30.                     ReDim Preserve xA(0 To ii)
    
31.                     xA(ii) = A
    
32.                     ii = ii + 1
    
33.                 ElseIf UBound(Ar) = 2 Then 'E1Q882.00-E1Q901.00-J07-K01_d3-h3-t18.csv
    
34.                     For i = 0 To 1
    
35.                         A(1) = Ar(i)                       '產品批號
    
36.                         S = Split(Split(Ar(2), "_")(0), "-")(i)
    
37.                         If Mid(S, 1, 1) = "N" Then
    
38.                             S = "Null"
    
39.                         Else
    
40.                             S = Mid(S, 2)
    
41.                         End If
    
42.                         A(6) = "'" & S                   '產品號碼
    
43.                         ReDim Preserve xA(0 To ii)
    
44.                         xA(ii) = A
    
45.                         ii = ii + 1
    
46.                     Next
    
47.                 End If
    
48.             End If
    
49.         End With
    
50.         xF.Close
    
51.         S = Dir
    
52.    Loop
    
53.   With Sheets.Add(, Sheets(1))
    
54.         '.Name = "搜尋結果"
    
55.         .[a1].Resize(ii, 6) = Application.Transpose(Application.Transpose(xA))
    
56.   End With
    
57. End Sub

複製代碼

lomchkimo

回復 2# GBKEE


GBKEE版大太強大了 !! 我原本摸一陣子還理不出基本頭緒 ,現在出現了一盞非常亮明燈,  感謝版大指導!! 謝謝!