1234
返回列表 上一主題 發帖

出貨單建立

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
21# 跳轉到 »
發表於 2022-10-12 08:09 | 只看該作者
回復 18# cclo0728


    前輩早安
範例請試試看
test_1_20221012_1.zip (31.36 KB)

開始情境:


[B2]左鍵快按兩下:


按 複製到出貨資料鈕 的出貨資料表結果


資料輸入表的結果:


Sub 搜尋出貨資料決定單號()

'↓數字與字串可以由一開始的宣告就決定這變數是字串或數字!
Dim Arr, T, xA, xB, N, Mx&, D1$, O1$, D2&, O2&, M1$, M2&
'↑宣告變數

Set xA = Sheets("資料輸入")
'↑令xA是 "資料輸入" 工作表

Set xB = Sheets("出貨資料")
'↑令xB是 "出貨資料" 工作表

M1 = xB.Cells(Rows.Count, "B").End(3)
'↑令M1這變數是 "資料庫" 工作表.B欄最後那儲存格 字串

M2 = M1
'↑令M2這變數是 M1變數轉整數

D1 = Format(Date, "yymmdd")
'↑令D1是今天日期組成的字串例如22/10/11 轉成 "221011"

D2 = D1 & "001"
'↑令D2是 組成今日第一筆出貨單的序號(數字)

If InStr(M1, D1) Then
'↑如果M1字串有包含D1字串

   xA.[B2] = M2 + 1
   '↑條件若成立!代表 "資料庫" 工作表已經有今天的序號
   '↑M2是數字就+1 填到 "資料輸入" 工作表的.[B2]
   
   xA.[B2].Interior.ColorIndex = xlNone
   '↑令 "資料輸入" 工作表的.[B2]底色無色
   
   xA.[B2].Font.ColorIndex = 1
   '↑令 "資料輸入" 工作表的.[B2]字色是黑色
   
   Else
      xA.[B2] = D2
      '↑否則代表今天還沒有存入今天的出貨單
      '↑"資料輸入" 工作表的.[B2] 就讓他是今天的第一筆序號D2
      
      xA.[B2].Interior.ColorIndex = xlNone
      '↑令 "資料輸入" 工作表的.[B2]底色無色
      
      xA.[B2].Font.ColorIndex = 1
      '↑令 "資料輸入" 工作表的.[B2]字色是黑色
      
End If
End Sub

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
22#
發表於 2022-10-12 09:38 | 只看該作者
回復 19# Andy2483
抱歉打擾到你這邊，讓你花時間寫程式
還是非常感謝

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
23#
發表於 2022-10-12 09:39 | 只看該作者
回復 20# Andy2483

出貨資料為每日出貨明細，所有出貨的資料全部建立在一個分頁
因不需要太複雜，加工廠的親人只會基礎excel
所以，對它們來講越簡單越好

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
24#
發表於 2022-10-12 09:41 | 只看該作者
回復 21# Andy2483

Sub 搜尋出貨資料決定單號()

'↓數字與字串可以由一開始的宣告就決定這變數是字串或數字!
Dim Arr, T, xA, xB, N, Mx&, D1$, O1$, D2&, O2&, M1$, M2&
'↑宣告變數

感謝，讓妳百忙之中花時間幫忙，非常謝謝
另外，請教O1&O2是宣告哪端的變數?

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
25#
發表於 2022-10-12 10:19 | 只看該作者
回復 24# cclo0728


    謝謝前輩回覆
O1,O2是上一版本漏刪除的!不影響執行!

工作空檔練習陣列與字典!
以後可以大幅縮短程式執行時間!

謝謝前輩提出主題與範例,後學可以學到很多!
學生就是該勤勞練習!
猜老師會考什麼? 也很有趣!

題目或範例考得太簡單!也要複雜化!
以檢測自己的思考是否周全!

學十幾年了!熱情依舊!
後學臉皮厚!心得註解也不擔心前輩指正或提醒 !
不違反版規!就好了!
人生的貴人就在 發帖/參與/回復主題 裡

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
26#
發表於 2022-10-12 11:04 | 只看該作者
回復 25# Andy2483
你實在太客氣了，非常謝謝你

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
27#
發表於 2022-10-12 14:40 | 只看該作者
回復 21# Andy2483

請問單號B2是使用什麼樣的方式達成像你這樣的設定?

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
28#
發表於 2022-10-12 16:51 | 只看該作者
回復 27# cclo0728


    運用觸發:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
   If .Address = "$B$2" Then
      Call 搜尋出貨資料決定單號
      
      Cancel = True
   End If
End With
End Sub

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
29#
發表於 2022-10-13 11:21 | 只看該作者
本帖最後由 Andy2483 於 2022-10-13 11:26 編輯

回復 27# cclo0728


    建議前輩:資料輸入彙整至出貨資料()裡多個程序!
檢查重複!
操作者不知情有重複序號:


出現提示:


跳至出貨資料重複儲存格處


正確不重複序號:


正確彙整至出貨資料表


Option Explicit
Public ERR&
Sub 資料輸入彙整至出貨資料()
Call 檢查出貨資料_序號重複

If ERR = 1 Then
'↑如果"出貨資料" 工作表找到相同序號
   ERR = 0
   '↑這個跨程式的變數歸零
   Exit Sub
End If
Dim Arr, T, xD, xA, xB
'↑宣告變數

Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典

Set xA = Sheets("資料輸入")
'↑令xA是工作表 "資料輸入"

Set xB = Sheets("出貨資料")
'↑令xB是工作表"出貨資料"

T = xA.Cells(Rows.Count, 3).End(3).Row - 4
'↑令T是"資料輸入"表要帶入 "出貨資料"表的列數

Arr = xA.Cells(5, 2).Resize(T, 6)
'↑來源表資料倒入Arr陣列

xD(1) = Arr
'↑Arr陣列倒入字典

xD(2) = xA.Cells(2, 1)
'↑客戶名稱倒入字典

xD(3) = xA.Cells(2, 2)
'↑單號倒入字典

xB.Cells(Rows.Count, "C").End(3).Offset(1, 0).Resize(UBound(Arr), 6) = xD(1)
'↑帶出陣列放入結果表

xB.Cells(Rows.Count, "A").End(3).Offset(1, 0).Resize(T, 1) = xD(2)
'↑帶出客戶名稱放入結果表

xB.Cells(Rows.Count, "B").End(3).Offset(1, 0).Resize(T, 1) = xD(3)
'↑帶出單號放入結果表

xA.[B2].Interior.ColorIndex = 3
xA.[B2].Font.ColorIndex = 2

Sheets("出貨資料").Activate
End Sub
Sub 檢查出貨資料_序號重複()
Dim xA, xB, BFind As Range
'↑宣告變數
Set xA = [資料輸入!B2]
'↑令xA是 "資料輸入" 工作表 [B2]
Set xB = [出貨資料!B:B]
'↑令xB是 "出貨資料" 工作表 B欄
Set BFind = xB.Find(xA, LookAt:=xlWhole)
'↑尋找 出貨資料!B:B 內容全相同儲存格
'↑(xA, LookAt:=xlPart) 是部分相同儲存格
If Not BFind Is Nothing Then
'↑如果有找到
   MsgBox "出貨資料已經有: " & xA & " 序號!"
   Sheets("出貨資料").Activate
   '↑畫面跳到 "出貨資料" 表
   BFind.Activate
   '↑選取找到的那個儲存格
   ERR = 1
   '↑是一個跨程式的變數,如果找到 令ERR = 1
End If
End Sub

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
30#
發表於 2022-10-14 08:00 | 只看該作者
本帖最後由 Andy2483 於 2022-10-14 08:09 編輯

回復 27# cclo0728


    前輩早安
後學早上複習了拆解長序號增加兩欄放入日期與短序號
練習陣列
提供前輩參考!
原出貨資料長序號篩選:


執行程式後產生新檔案可篩選日期:


新檔案可篩選短序號:


以下複習的程式碼供參考:
Option Explicit
Sub 長序號轉_日期_短序號()
Dim Arr, i&, xB, N&, D1 As Date
'↑宣告變數:D1 是日期,N是數字

Set xB = Sheets("出貨資料")
'↑令xB是 "出貨資料" 工作表

Arr = xB.Range(xB.[J1], Cells(xB.UsedRange.EntireRow.Count, 1))
'↑令Arr是"出貨資料" 工作表 A:G欄之間有使用列的區域儲存格值

For i = 2 To UBound(Arr)
'↑設迴圈拆解B欄的長序號

   D1 = "20" & Mid(Arr(i, 2), 1, 2) & "/" & Mid(Arr(i, 2), 3, 2) & "/" & Mid(Arr(i, 2), 5, 2)
   '↑ "20",加長序號第1個字開始取兩字元="22"
   ',再加長序號第3個字開始取兩字元="10"
   ',再加長序號第5個字開始取兩字元="08"
   'D1="2022/10/08"字串轉化為日期,因D1宣告為日期
   
   Arr(i, 9) = D1
   '↑把D1日期放入Arr的第9欄位置
   
   N = Right(Arr(i, 2), 3)
  '↑令N是常序號的右邊3個字元字串轉數字,因N宣告為數字
   
   Arr(i, 10) = N
   '↑把N數字放入Arr的第10欄位置
   
Next
Workbooks.Add
'↑開一個新的檔案

[A1].Resize(UBound(Arr), 10) = Arr
'↑把Arr陣列的資料從[A1]開始倒入新工作表的存格

[I1] = "出貨日期"
[J1] = "當日序號"
Cells.Columns.AutoFit
'↑自動調整欄寬

Cells.Rows.AutoFit
'↑自動調整列高

[2:2].Select
ActiveWindow.FreezePanes = True
'↑第二列以上儲存格凍結窗格

[A1].Select
[A1].AutoFilter
'↑設定篩選

Cells.Borders.LineStyle = xlContinuous
'↑顯示格線
End Sub

TOP

        靜思自在 : 道德是提昇自我的明燈，不該是呵斥別人的鞭子。
1234
返回列表 上一主題