dea172

回復 10# 准提部林

版主你好,
１．每個IPQC是否各對應一個FQC？　且檔案名稱前綴相同？
　　例如：L-26P-2018-IPQC　對應　L-26P-2018-FQC，相同為"L-26P-2018"
->   其實檔案是一對一的, 不會共用, 所以程式可以分別設定不會影響

２．IPQC的Ａ欄項目數量是〔固定〕的？　且必與FQC相對應？
->    IPQC A 欄位式固定的, 且與FQC 相對應

３．抓５格或抓２格的規則是什麼？
　　或者，可利用IPQC的Ｋ欄，抓５筆的輸入５，抓２筆的輸入２，就用這來判斷抓幾格
->   其實我的想法是, 針對不同需求設定不同檔案, 直接將檔案綁死, 怕使用者會有key in 錯誤風險

准提部林

回復 9# dea172


2.IPQC 檔案 H欄位有五個數值, FQC 只抓取前兩個數值(參閲檔案L-15-3)
圖片看是M欄位???
是否用"M"來判斷取2格???  還是[最後一筆]取2格???

2.IPQC 檔案 P/M欄位有五個數值, FQC 各抓取前兩個數值(參閲檔案L-26P)
是否用"P"或"M"判斷取2格???  或是[最後2筆]取2格???

然後, FQC檔案名稱不是固定的, 無法寫死在程式裡(不然每次都要手改)???

dea172

回復 12# 准提部林

版主你好,
不好意思, 要再次麻煩
2.IPQC 檔案 H欄位有五個數值, FQC 只抓取前兩個數值(參閲檔案L-15-3)
圖片看是M欄位???
是否用"M"來判斷取2格???  還是[最後一筆]取2格???
-> 這个會隨著資料而不同, 這是否可以依需求而自行變更?
EX: 要"M"欄位, 就從程式中更改為"M"欄位
       要"H"欄位, 就從程式中更改為"H"欄位

2.IPQC 檔案 P/M欄位有五個數值, FQC 各抓取前兩個數值(參閲檔案L-26P)
是否用"P"或"M"判斷取2格???  或是[最後2筆]取2格???
->  對, 這比較特別, 這个檔案為[最後2筆]取2格
然後, FQC檔案名稱不是固定的, 無法寫死在程式裡(不然每次都要手改)???
->  FQC檔案名稱這个我可以依照我的檔案需求手動更改變更

Hsieh

回復 13# dea172

1. Sub FQC_IPQC()
   
2. Dim Ay(0 To 1), A As Range, C As Range, y&, d#, m&, i!, Lot1$, Lot2, f, fd$, fs$, fc$
   
3. Do
   
4. fd = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "請選擇IPQC檔", , False)
   
5. f = Split(fd, "\")
   
6. fs = f(UBound(f))
   
7. If InStr(fs, "IPQC") = 0 Then MsgBox "檔案選取不是IPQC檔" & Chr(10) & "請重新選擇"
   
8. Loop While InStr(fs, "IPQC") = 0
   
9. fc = Replace(fd, "IPQC.xls", "FQC.xls")
   
10. With Workbooks.Open(fc)
    
11. With Workbooks.Open(fd)
    
12.    With .Sheets("Transfer")
    
13.       Lot1 = Split(.[G2], "-")(0) & "-FQC3"
    
14.       Lot2 = Split(.[G2], "-")(0) & "-FQC2"
    
15.       y = Year(.[C1])
    
16.       d = CDate(Format(.[C1], "m/d"))
    
17.       m = .[L4]
    
18.       Ay(0) = Array(Lot1, y, d, m)
    
19.       Ay(1) = Array(Lot2, y, d, m)
    
20.       Dim ar(0 To 1, 0 To 34)
    
21.       For Each A In .[F4:F15]
    
22.         For i = 0 To 2
    
23.             ar(0, s) = A.Offset(, i).Value
    
24.             ar(1, s) = A.Offset(, i + 3).Value
    
25.             s = s + 1
    
26.             If s = 35 Then GoTo 10
    
27.         Next
    
28.       Next
    
29. 10
    
30.     End With
    
31.     .Close 0
    
32. End With
    
33. With .Sheets("Input")
    
34.   Set C = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
    
35.   C.Resize(2, 4) = Application.Transpose(Application.Transpose(Ay))
    
36.   C.Offset(, 4).Resize(2, 35) = ar
    
37. End With
    
38. End With
    
39. End Sub

複製代碼

dea172

回復 14# Hsieh

版主你好,
感謝幫忙, 我有試過,
1.沒有重複批號確認,
2.每傳一次資料, 使用者還需要開啟IPQC 檔案, 是否有更方便方式, 謝謝!
註: IPQC & FQC 檔案都是放同一資料夾下

准提部林

回復 15# dea172


IPQC-FQC.rar (167 KB)

下載次數: 1

2018-4-19 16:05

這個FQC檔名自動與IPQC匹配:
IPQC-FQC-2.rar (168.17 KB)

下載次數: 3

2018-4-19 16:10

dea172

回復 16# 准提部林

版主你好,
測試後OK, 不好意思, 但我還有一個問題想請教, 再次麻煩了, 謝謝
若想跳過 IPQC檔案的 P 欄位, 複製時不將P欄位複製到FQC內, 是否有程式可使用?

下載 (246.6 KB)

2018-4-19 16:20

准提部林

回復 17# dea172

For i = 0 To UBound(Arr) - 1
    If Arr(i + 1, 1) = "P" Then
       '這裡空白即可(不做任何動作)
    ElseIf Arr(i + 1, 1) = "M" Then
       For j = 5 To 6: Brr(1, i * 3 + j) = Arr(i + 1, j + 1): Next j '只抓前2格
     Else
       For j = 5 To 7: Brr(1, i * 3 + j) = Arr(i + 1, j + 1): Next j '抓前3格
           For j = 5 To 6: Brr(2, i * 3 + j) = Arr(i + 1, j + 4): Next j '抓後2格
    End If
Next i

准提部林

回復 17# dea172

若是要排除多個:
If InStr("-A2-H-P-", "-" & Trim(Arr(i + 1, 1)) & "-") Then

A2,H,P 都不錄入

因為檔案中A2後多了一個空格, 須用Trim清除

記住：這個排除要放在IF條件的第一個，其它再用ELSEIF接其它條件

准提部林

為了防呆，在程式碼的前端再加這三行：
If IsDate([C1]) = False Then MsgBox "日期格式錯誤或未輸入!!": Exit Sub
If [E1] = "" Then MsgBox "Machine No 未輸入!!": Exit Sub
If [G1] Like "########-####" = False Then MsgBox "Lot No 錯誤或未輸入!!": Exit Sub