- 帖子
- 2808
- 主題
- 10
- 精華
- 0
- 積分
- 2864
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-5-19
|
8#
發表於 2018-4-18 15:47
| 只看該作者
回復 7# dea172 - Private Sub CommandButton2_Click()
- Dim Arr, Brr, i&, j%, xE As Range
- Arr = [A3:J17]
- ReDim Brr(1 To 2, 1 To [A:AV].Columns.Count)
- Brr(1, 1) = Split([G1], "-")(0) & "-FQC3"
- Brr(2, 1) = Split([G1], "-")(0) & "-FQC2"
- Brr(1, 2) = Year([C1]): Brr(2, 2) = Year([C1])
- Brr(1, 3) = [C1]: Brr(2, 3) = [C1]
- Brr(1, 4) = [E1]: Brr(2, 4) = [L2]
- For i = 0 To UBound(Arr) - 1
- If i >= UBound(Arr) - 2 Then '最後兩筆(L/M)
- 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
- Dim xN$, xB As Workbook, xS As Worksheet, xF As Range
- xN = "L-15-3-2018-FQC.xls"
- On Error Resume Next '以下三行可以檢查FQC是否開啟中
- Set xB = Workbooks(xN)
- If xB Is Nothing Then Set xB = Workbooks.Open(ThisWorkbook.Path & "\" & xN) '若未開啟,執行開啟檔案
- On Error GoTo 0
- If xB Is Nothing Then MsgBox "找不到〔" & xN & "〕檔案": Exit Sub
- Set xS = xB.Sheets("輸入表")
- Set xF = xS.[A:A].Find(Split(Brr(1, 1), "-")(0), Lookat:=xlPart)
- If Not xF Is Nothing Then MsgBox "批號重覆": xB.Close 0: Exit Sub
- Set xE = xS.[A65536].End(xlUp)(2)
- If xE.Row < 6 Then Set xE = xE(2)
- xE.Resize(2, UBound(Brr, 2)) = Brr
- xB.Close 1 '關閉FQC, 並存檔
- End Sub
 L-15-3-2018-IPQC.rar (75.84 KB)
|
|
發表於 2018-4-19 10:50
| 
