Sub 客戶訂購表_輸出()
'程式資料來源至准提部林_出貨作業D版V01_10905
Dim R&, CN&, Arr, Brr, Crr, Drr, QQ, i&, j%, N&, xE As Range, X%, Mch, xNum&, PNo$, CL$
R = [L65536].End(xlUp).Row
CN = Application.Count(Range("M4:M" & R))
If CN = 0 Then MsgBox "**尚未輸入數量! ": Exit Sub
If [E2] = "" Then MsgBox "**尚未輸入客戶名稱! ": Exit Sub
If Not IsDate([E4]) Then MsgBox "**日期空白或錯誤! ": Exit Sub
'------------------------------------
xNum = [V2] '單號
CL = [E2] '客戶
'程式資料來源至准提部林_出貨作業D版V01_10905
If Not xNum Like String(10, "#") Then MsgBox "**單號錯誤或空白! ": Exit Sub
If Left(xNum, 7) <> Year([E4]) - 1911 & Format([E4], "mmdd") Then MsgBox "**單號前７碼與日期不相符! ": Exit Sub
Mch = Application.Match(xNum, [訂貨明細表!K:K], 0)
If IsNumeric(Mch) Then MsgBox "**單號已存在! ": Exit Sub
Mch = Application.Match(xNum, [訂貨明細表!A:A], 0)
If IsNumeric(Mch) Then MsgBox "**客戶已存在! ": Exit Sub >>>>需求=更改增加上可允許重複繼續執行
剛測試用客戶名是數字(991)(992)993)....等等都是以數字編號.完全運作.無錯誤
換上正常使用版之客戶名是以中文.列(A車).(B車)(福華飯店)等等有中文時出現錯誤現象
CL=[e2]顯示出(執行階段錯誤"13"型態不符合)
是否可改?
原程式
Sub 客戶訂購表_輸出()
Dim R&, CN&, Arr, Brr, Crr, Drr, QQ, i&, j%, N&, xE As Range, X%, Mch, xNum&, PNo$
R = [L65536].End(xlUp).Row
CN = Application.Count(Range("M4:M" & R))
If CN = 0 Then MsgBox "**尚未輸入數量! ": Exit Sub
If [E2] = "" Then MsgBox "**尚未輸入客戶名稱! ": Exit Sub
If Not IsDate([E4]) Then MsgBox "**日期空白或錯誤! ": Exit Sub
'------------------------------------
xNum = [V2] '單號
If Not xNum Like String(10, "#") Then MsgBox "**單號錯誤或空白! ": Exit Sub
If Left(xNum, 7) <> Year([E4]) - 1911 & Format([E4], "mmdd") Then MsgBox "**單號前７碼與日期不相符! ": Exit Sub
Mch = Application.Match(xNum, [訂貨明細表!K:K], 0)
If IsNumeric(Mch) Then MsgBox "**單號已存在! ": Exit Sub
原程式增列 CL&
CL = [e2] '客戶
這2地方
修改後程式
Sub 客戶訂購表_輸出()
'程式資料來源至准提部林_出貨作業D版V01_10905
Dim R&, CN&, Arr, Brr, Crr, Drr, QQ, i&, j%, N&, xE As Range, X%, Mch, xNum&, PNo$, CL&
R = [L65536].End(xlUp).Row
CN = Application.Count(Range("M4:M" & R))
If CN = 0 Then MsgBox "**尚未輸入數量! ": Exit Sub
If [e2] = "" Then MsgBox "**尚未輸入客戶名稱! ": Exit Sub
If Not IsDate([E4]) Then MsgBox "**日期空白或錯誤! ": Exit Sub
'------------------------------------
xNum = [V2] '單號
CL = [e2] '客戶
'程式資料來源至准提部林_出貨作業D版V01_10905
If Not xNum Like String(10, "#") Then MsgBox "**單號錯誤或空白! ": Exit Sub
If Left(xNum, 7) <> Year([E4]) - 1911 & Format([E4], "mmdd") Then MsgBox "**單號前７碼與日期不相符! ": Exit Sub
Mch = Application.Match(xNum, [訂貨明細表!K:K], 0)
If IsNumeric(Mch) Then MsgBox "**單號已存在! ": Exit Sub
'Mch = Application.Match(CL, [訂貨明細表!A:A], 0)
'If IsNumeric(Mch) Then MsgBox "**客戶已存在! ": Exit Sub
Mch = Application.Match(CL, [訂貨明細表!A:A], 0) '檢查單號是否存在
If IsNumeric(Mch) Then
Beep '若存在, 發出嗶聲, 並提示是否進行補增???
If MsgBox("**客戶已存在! 你要繼續輸入本張訂單嗎? ", 4 + 32 + 256) = vbNo Then Exit Sub '按"否"結束
[e2] = [訂貨明細表!A:A].Cells(Mch, 1) '按"是", 自動填入"客戶名", 加入增補明細~~
End If作者: 准提部林 時間: 2021-7-3 17:21
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 & "已經有資料! ": Exit Sub
End If
Next i
End If
Mch = Application.Match(CLng(DD), [訂貨明細表!L:L], 0) '先檢查日期是否存在
If IsNumeric(Mch) Then
Arr = Range([訂貨明細表!L1], [訂貨明細表!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 '日期相同+客戶相同(QQ = [E2] '客戶......原有設定)
MsgBox "※日期:" & DD & "，客戶:" & NM & "已經有資料! ": Exit
.................................................................................
Beep '若存在, 發出嗶聲, 並提示是否進行補增???
If MsgBox("**客戶已存在! 你要繼續輸入本張訂單嗎? ", 4 + 32 + 256) = vbNo Then Exit Sub '按"否"結束
[e2] = [訂貨明細表!A:A].Cells(Mch, 1) '按"是", 自動填入"客戶名", 加入增補明細~~
....................................................
匯成
xNum = [V2] '單號
cName = [e2] '客戶.....
NM = [E2] '客戶......
DD = [E4] '日期
QQ = [E2] '客戶......原有設定
'程式資料來源至准提部林_出貨作業D版V01_10905
If Not xNum Like String(10, "#") Then MsgBox "**單號錯誤或空白! ": Exit Sub
If Left(xNum, 7) <> Year([E4]) - 1911 & Format([E4], "mmdd") Then MsgBox "**單號前７碼與日期不相符! ": Exit Sub
Mch = Application.Match(xNum, [訂貨明細表!K:K], 0)
If IsNumeric(Mch) Then MsgBox "**單號已存在! ": Exit Sub
Mch = Application.Match(CLng(DD), [訂貨明細表!L:L], 0) '先檢查日期是否存在
If IsNumeric(Mch) Then
Arr = Range([訂貨明細表!L1], [訂貨明細表!A1].Cells(Rows.Count, 1).End(xlUp))
For i = Mch To UBound(Arr)
If Arr(i, 12) <> DD Then Exit For
If Arr(i, 12) = DD And Arr QQ = NM Then '日期相同+客戶相同(QQ = [E2] '客戶......原有設定)
MsgBox "※日期:" & DD & "，客戶:" & NM & "已經有資料! ": Exit Sub
End If
Next i
End If
........
Beep '若存在, 發出嗶聲, 並提示是否進行補增???
If MsgBox("**客戶已存在! 你要繼續輸入本張訂單嗎? ", 4 + 32 + 256) = vbNo Then Exit Sub '按"否"結束
[e2] = [訂貨明細表!A:A].Cells(Mch, 1) '按"是", 自動填入"客戶名", 加入增補明細~~
End If
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'程式資料來源至准提部林_1100624_X10000045_1
Dim R&, CN&, xE As Range
With Target
If .Column <> [P1].Column Or .Value = "" Then Exit Sub
R = Cells(Rows.Count, "k").End(3).Row
Cancel = True
If .Row = 1 Then
With Range("e1:n" & R)
.Borders.LineStyle = 1
.Columns(9) = .Columns(9).Value
End With
Range("h1:h" & R).Formula = "=IF(ROW(A1)=1,""(KG)"",IF(F1=""台斤"",(MOD(E1,1)*100/16+INT(E1)),E1)*G1)"
Else
Set xE = Range("K1:K" & R).Find(.Value, lookat:=xlWhole)
If xE Is Nothing Then MsgBox "＊找不到指定的單號！ ": Exit Sub
CN = Application.CountIf(Range("K" & xE.Row & ":K" & R), .Value)
With Range("e" & xE.Row).Resize(CN, 10)
.Columns(9) = "=SUM(" & .Columns(4).Address & ")"
.BorderAround Weight:=xlMedium, ColorIndex:=3
.Item(1).Select
.Item(1).Font.Color = vbRed
End With
End If
End With
End Sub
...........
至於"輸入"這追加部份則是需再產生另一單號.
例如:7月24日輸入了一張出貨單, 客戶:陳一, 單號:"1100724001", 共輸入10筆項目,
7月24日臨時客戶:陳一追加了3種商品,則客戶:陳一, 單號:"1100724002", 共輸入3筆項目,這也完成
......................
xNum = [V2] '單號
cName = [E2] '客戶
'程式資料來源至准提部林_出貨作業D版V01_10905
If Not xNum Like String(10, "#") Then MsgBox "**單號錯誤或空白! ": Exit Sub
If Left(xNum, 7) <> Year([E4]) - 1911 & Format([E4], "mmdd") Then MsgBox "**單號前７碼與日期不相符! ": Exit Sub
Mch = Application.Match(xNum, [訂貨明細表!K:K], 0)
If IsNumeric(Mch) Then MsgBox "**單號已存在! ": Exit Sub
'Mch = Application.Match(CL, [訂貨明細表!A:A], 0)
'If IsNumeric(Mch) Then MsgBox "**客戶已存在! ": Exit Sub
'程式資料來源至准提部林_2021_7_3指導
Mch = Application.Match(cName, [訂貨明細表!A:A], 0) '檢查客戶是否存在
If IsNumeric(Mch) Then
Beep '若存在, 發出嗶聲, 並提示是否進行補增???
If MsgBox("**客戶已存在! 你要繼續輸入本張訂單嗎? ", 4 + 32 + 256) = vbNo Then Exit Sub '按"否"結束
[E2] = [訂貨明細表!A:A].Cells(Mch, 1) '按"是", 自動填入"客戶名", 加入增補明細~~
End If
...........................
現在問題所在是因訂貨明細表中
例)7月1日客戶:陳一, 單號:"1100701001"共輸入10筆項目
7月1日客戶:陳一臨時追加, 單號:"1100701002"共輸入1筆項目
7月2日客戶:陳一, 單號:"1100702001"共輸入5筆項目
因Mch = Application.Match(cName, [訂貨明細表!A:A], 0) '檢查客戶是否存在.
("其功能是防止客戶重複輸入"造成"採購需求"失真)
Sub 客戶訂購表_修改輸入() '＝2021.07.10增修＝＝＝＝＝＝＝＝＝＝＝
Dim cNo$, xF As Range
If [n5] = "修改中" Then MsgBox "※正在修改作業中，若想進行其他操作，請按〔重置〕！ ": Exit Sub
Re_Try:
cNo = InputBox("※請輸入十位數出貨單號，再按確定！ ", , cNo)
If StrPtr(cNo) = 0 Then Exit Sub
If Not cNo Like String(10, "#") Then MsgBox "※出貨單號空白或格式錯誤! ": GoTo Re_Try
Set xF = [訂貨明細表!J:J].Find(cNo, Lookat:=xlWhole)
If xF Is Nothing Then MsgBox "※找不到這筆出貨單號! ": GoTo Re_Try
Set xF = xF(1, 2 - xF.Column) '將xF定位到A欄
[o2] = cNo '單號
[a2] = xF '客戶名稱
[A4] = xF(1, 11) '日期
[a8] = xF(1, 13) '採購單號
[n5] = "修改中" '狀態格
End Sub作者: 准提部林 時間: 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
