- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 104
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-5-6
              
|
回復 13# dea172 - Sub FQC_IPQC()
- Dim Ay(0 To 1), A As Range, C As Range, y&, d#, m&, i!, Lot1$, Lot2, f, fd$, fs$, fc$
- Do
- fd = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "請選擇IPQC檔", , False)
- f = Split(fd, "\")
- fs = f(UBound(f))
- If InStr(fs, "IPQC") = 0 Then MsgBox "檔案選取不是IPQC檔" & Chr(10) & "請重新選擇"
- Loop While InStr(fs, "IPQC") = 0
- fc = Replace(fd, "IPQC.xls", "FQC.xls")
- With Workbooks.Open(fc)
- With Workbooks.Open(fd)
- With .Sheets("Transfer")
- Lot1 = Split(.[G2], "-")(0) & "-FQC3"
- Lot2 = Split(.[G2], "-")(0) & "-FQC2"
- y = Year(.[C1])
- d = CDate(Format(.[C1], "m/d"))
- m = .[L4]
- Ay(0) = Array(Lot1, y, d, m)
- Ay(1) = Array(Lot2, y, d, m)
- Dim ar(0 To 1, 0 To 34)
- For Each A In .[F4:F15]
- For i = 0 To 2
- ar(0, s) = A.Offset(, i).Value
- ar(1, s) = A.Offset(, i + 3).Value
- s = s + 1
- If s = 35 Then GoTo 10
- Next
- Next
- 10
- End With
- .Close 0
- End With
- With .Sheets("Input")
- Set C = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
- C.Resize(2, 4) = Application.Transpose(Application.Transpose(Ay))
- C.Offset(, 4).Resize(2, 35) = ar
- End With
- End With
- End Sub
|
|
發表於 2018-4-19 15:37
| 