返回列表 上一主題 發帖

[發問] 如何修訂增列程式

本帖最後由 BV7BW 於 2021-7-24 17:28 編輯

回復 20# 准提部林
謝謝 准提部林 老師

關于"修改""這部份已完成

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 "**單號前7碼與日期不相符! ": 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) '檢查客戶是否存在.
("其功能是防止客戶重複輸入"造成"採購需求"失真)

所以它是檢查"訂貨明細表"中有客戶:陳一,都會先檢查1次.其功用因此只有1半作用
也就是說只有每月第1次客戶:陳一.或"訂貨明細表"中沒有客戶:陳一其功用才能呈現出

現在做法是多1動作先將每日"訂貨明細表"手動複製另1工作表"訂貨存檔"貼上後將"訂貨明細表"清空.
問題就解結了

因而提問"工作表複製跨另一檔案工作表"問題

如能在"Mch = Application.Match(cName, [訂貨明細表!A:A], 0) '檢查客戶是否存在"中
加上或改為以日期每日以客戶做檢查既可.不用再增列另一工作表"訂貨存檔"直接以"訂貨明細表"作為存檔資料
在每月以訂貨明細表中資料再另存新檔作為歷史資料存檔

   感謝  准提部林 老師 指導
敏而好學,不恥下問

TOP

回復 21# BV7BW

現在問題所在是因訂貨明細表中
例)7月1日客戶:陳一, 單號:"1100701001"共輸入10筆項目
   7月1日客戶:陳一臨時追加, 單號:"1100701002"共輸入1筆項目
   7月2日客戶:陳一, 單號:"1100702001"共輸入5筆項目
  


我18樓上的附件, 你可能都沒測試....
7月1日客戶:陳一, 單號:"1100701001"共輸入10筆項目....ok
7月1日客戶:陳一臨時追加, 單號:"1100701002"共輸入1筆項目....不行, 程式會擋掉, 因同一天, 一個客戶只能有一張單子, 不能有兩個單號, 只能輸入1100701001執行修改增加

7月2日客戶:陳一, 單號:"1100702001"共輸入5筆項目....OK, 日期已經不同, 不會視為客戶重覆

TOP

這是新增的部份:
注意:儲存格 N5...會有"待命中/修改中" 狀態, 以判斷你執行的是"新增" 或 "修改
  

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

TOP

藍色部份是修改或新增的部份!!!

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 "**單號前7碼與日期不相符! ": 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


'*********************************************

TOP

藍色部份是修改或新增的部份!!!  

Sub 客戶訂購表_重置()
Dim R&
If MsgBox("※確定要重置輔助公式及清除輸入數量嗎?  ", 4 + 32 + 256) = vbNo Then Exit Sub
R = [B65536].End(xlUp).Row
Range("G3:G" & R).ClearContents
Call 客戶訂購表_輔助公式
'=2021.07.10增修===========
[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 Sub

TOP

回復 25# 准提部林

感謝 准提部林 老師 指導
因更改區域很多.我可須再慢慢理解消化中
(**重點**:主要是預警客戶重複.輸入".追加部份則是需再產生另一單號.這部份已完成程式資料來源至准提部林_出貨作業D版V01_10905.
          (不是修改或增加原訂單單號內容).(關于"修改""這部份已完成.程式資料來源至准提部林_1100624_X10000045_1)
          **單號是固定連續編排.當日用過之單號不可再更動使用**
          目前做法先將每日"訂貨明細表"手動複製另1工作表"訂貨存檔"貼上後將"訂貨明細表"清空.
**測試後**
客戶與日期可同時一起檢查作用.但會延伸問題出現
訂單單號問題.需再回明細表中找尋客戶訂單單號.重新輸入單號(如輸入錯誤則產生混合訂單(列A車客戶與B車客戶混合同一訂單單號)
             更改重置後.需重新回訂貨表找當日最後單號.再輸入訂購表之單號.造成不便

             重置後單號錯誤(執行錯誤1004.應用程式與物件定義上錯誤).不能恢復.需手動輸入
          謝謝
敏而好學,不恥下問

TOP

回復 26# BV7BW

邏輯跟不上, 整個都混了....
回到原點:
輸出時--檢查同一日是否有相同的客戶,
若有...提示訊息..按"否"-不動作結束...按"是"-以新單號輸出至明細表
出貨作業D版v01_1100725.rar (377.44 KB)

同一日, 客戶有新追加者, 都以新單號處理, 不再用舊單號作增補了!!!

TOP

回復 27# 准提部林

准提部林 老師 你好

謝謝你 老師 辛勞指導

經測試後需求已達到完全俯合
以客戶&日期作為檢查動作

還有1點點小問題(但沒關緊要)

就是說.當檢查到重複時須按完該單號所有項目後才可輸入

列)客戶:陳一單號1090529004有3項目.完成訂單
   當需追加時客戶:陳一單號1090529005有3項目.會去檢查動作需按1090529004單號所有項目後.
   才可輸入1090529005訂單單號完成

   也就是說要按3下後1090529005單號才能成立

   再如有第3筆訂單單號客戶:陳一單號1090529006有1項目
   就需按6下(11090529004有3項目.1090529005有3項目)才可輸入1090529006訂單單號

   如能只檢查該筆單號第1項目既可.有第2筆時一樣只檢查第1筆
   等於第2筆單號須按1下.第3筆單號須按2下

  感謝 准提部林 老師
敏而好學,不恥下問

TOP

回復 28# BV7BW

If Arr(i, 11) = DD And Arr(i, 1) = NM Then '日期相同+客戶相同
    Beep '若存在, 發出嗶聲, 並提示是否進行補增???
    If MsgBox("※日期:" & DD & ",客戶:" & NM & ",單號:" & Arr(i, 10) & ",已經有資料!   " & vbCrLf & vbCrLf & _
          ",你要繼續輸入本張訂單嗎?  ", 4 + 32 + 256) = vbNo Then Exit Sub  '按"否"結束
    Exit For  '加這一行
End If

TOP

回復 29# 准提部林
謝謝你 准提部林 老師指導

完全俯合需求
多次煩擾老師.真非常抱歉與感謝
敏而好學,不恥下問

TOP

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題