- 帖子
- 2798
- 主題
- 10
- 精華
- 0
- 積分
- 2854
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-4-20
|
24#
發表於 2021-7-24 19:44
| 只看該作者
藍色部份是修改或新增的部份!!!
Sub 客戶訂購表_輸出()
Dim R&, CN&, Arr, Brr, Crr, Drr, QQ, i&, j%, N&, xE As Range, X%, Mch, xNum&, pNo$
R = [F65536].End(xlUp).Row
CN = Application.Count(Range("G4:G" & R))
If CN = 0 Then MsgBox "**尚未輸入數量! ": Exit Sub
If [a2] = "" Then MsgBox "**尚未輸入客戶名稱! ": Exit Sub
If Not IsDate([A4]) Then MsgBox "**日期空白或錯誤! ": Exit Sub
'------------------------------------
xNum = [o2] '單號
If Not xNum Like String(10, "#") Then MsgBox "**單號錯誤或空白! ": Exit Sub
If Left(xNum, 7) <> Year([A4]) - 1911 & Format([A4], "mmdd") Then MsgBox "**單號前７碼與日期不相符! ": Exit Sub
'///2021.07.13增修////////////////////////////
Mch = Application.Match(xNum, [訂貨明細表!J:J], 0) '檢查單號是否已存在
If [n5] <> "修改中" Then
If IsNumeric(Mch) Then MsgBox "**單號已存在! ": Exit Sub
NM = [a2] '客戶
DD = [A4] '日期
Mch = Application.Match(CLng(DD), [訂貨明細表!k:k], 0) '先檢查日期是否存在
If IsNumeric(Mch) Then
Arr = Range([訂貨明細表!m1], [訂貨明細表!a1].Cells(Rows.Count, 1).End(xlUp))
For i = Mch To UBound(Arr)
If Arr(i, 11) <> DD Then Exit For
If Arr(i, 11) = DD And Arr(i, 1) = NM Then '日期相同+客戶相同
MsgBox "※日期:" & DD & "，客戶:" & NM & "已經有資料! " & vbCrLf & _
" 若想新增舊訂單的內容，請使用〔修改輸入〕按鈕！ "
Exit Sub
End If
Next i
End If
End If
'////////////////////////////////////////////////
'-----------------------------------------------
pNo = [a8].Text
If UCase(Right([M2], 1)) = "S" And pNo = "" Then
MsgBox "**【客戶編號：" & [M2] & "】結尾有""S"", 必須輸入【採購單號】, " & vbCrLf & vbCrLf & _
"若沒有【採購單號】,或暫時不輸入, 請輸入0!"
[a8].Select: Exit Sub
End If
If pNo = "N/A" Then pNo = ""
'-----------------------------------------------
Arr = Range("D4:J" & R)
ReDim Crr(1 To CN, 1 To 13)
For i = 1 To UBound(Arr)
If Val(Arr(i, 4)) <= 0 Then GoTo 101
N = N + 1
'(1)客戶(2)客戶編號(3)項目編號(4)項目名稱(5)數量(6)單價(7)金額(8)類別(9)車編(10)單號(11)日期(12)合計金額(13)採購單號
QQ = Array([a2], [M2], Arr(i, 1), Arr(i, 2), Arr(i, 4), Arr(i, 5), "=N(RC[-2])*N(RC[-1])", Arr(i, 7), [M4], xNum, [A4], Val([O7]), pNo)
For j = 0 To UBound(QQ)
Crr(N, j + 1) = QQ(j)
Next j
101: Next i
If N = 0 Then Exit Sub
'-------------------------------------
'＝2021.07.10增修＝＝＝＝＝＝＝＝＝＝＝
With Sheets("訂貨明細表")
With .[A65536].End(xlUp)(2).Resize(N, UBound(Crr, 2))
.Value = Crr
If [n5] = "修改中" Then .Interior.ColorIndex = 35 '若屬修改..填淡綠色
End With
Range(.[m1], .[A65536].End(xlUp)).Sort Key1:=.[j1], Order1:=xlAscending, Header:=xlYes
End With
If [n5] = "修改中" Then
[o2].Formula = "=IF(A4="""","""",IF(ISNA(MATCH(A4,訂貨明細表!K:K,)),TEXT(A4,""emmdd"")*1000,LOOKUP(TEXT(A4+1,""emmdd"")*1000,訂貨明細表!J:J))+1)"
[n5] = "待命中"
End If
'=======================================
'-------------------------------------
ChangeChk = 1: [送貨單!B2] = xNum
Call 送貨單_載入: ChangeChk = 0
'----------------------------------------
Range("G4:G" & R).ClearContents: [a2] = "": [a8] = "" '清除:數量/客戶/採購單號, 供下次輸入
If MsgBox("※輸出完成, 是否要立即跳至[送貨單]?? ", 4 + 32 + 256) = vbYes Then Application.Goto [送貨單!A7]
End Sub
'********************************************* |
|
發表於 2021-7-2 08:14
| 
