用Marco簡化輸入資料

john2006168

有些要找老師和高手幫忙,        萬分感激.                       
        我平時會在sheets"checking"的A2用 scaner掃瞄文件上的bar code號碼,或者手入shipmenr ref no,再將bacth no的資料更新到shipment record相對應的欄位                               
        因為每日很多資料希望可用marco簡化.                               
Sheet        Checking                  shipment record                       
        欄 B                                                              欄 R                       
        欄 C                                                          欄 O                       
        計算多少個BATCH  ITEMS的總和          欄 P                       
        欄 E                                                                  欄 Q                       
        欄 F                                                                   欄 T                       
        欄 G                                                          欄 S

luhpro

有些要找老師和高手幫忙,        萬分感激.                       
        我平時會在sheets"checking"的A2用 scaner掃瞄文件上的bar code號 ...
john2006168 發表於 2019-3-1 09:45

抱歉,不是看得很懂你的意思,只能以自己的理解來實作了.

在此假設你是要在輸入Barcode時,
自動在Data中以SHIPMENT REF欄位為鍵值,
找到相關資料帶入shipment record內,
那麼程式可以這樣寫 :(底下===中是程式所放的地方)

首先,將Data的資料建立索引以方便之後抓取,
這裡有個Dictionary函數滿好用的,
它可以直接建立相關索引.
另外,為了方便後續取用,
也將定義三個工作表.

因為都要在不同的Sheet中也能使用,
所以要在模組中使用Public來定義
===Module1===

1. Public dShi
   
2. Public shDat As Worksheet, shChk As Worksheet, shShr As Worksheet

複製代碼

其次,要在程式一執行就先將Data的資料建立索引以方便之後抓取,
所以要放在 Workbook_Open 裡.
===ThisWorkBook 的 Workbook_Open===

1. Dim lRow&, lRows&
   
2.   
   
3.   Set shDat = Sheets("Data")
   
4.   Set shChk = Sheets("Checking")
   
5.   Set shShr = Sheets("shipment record")
   
6.   
   
7.   Set dShi = CreateObject("Scripting.Dictionary")
   
8.   
   
9.   With shDat
   
10.     lRows = .Cells(Rows.Count, 1).End(xlUp).Row
    
11.     For lRow = 2 To lRows
    
12.       dShi(CStr(.Cells(lRow, 8))) = lRow
    
13.     Next
    
14.   End With

複製代碼

(題外話)這裡忍不住又要再講一次,
建立 Dictionary 的函數範例中,
Scripting.Dictionary 從一開始就忘了加雙引號,
一直到現在仍然還是沒加...囧
剛開始學習時我在這裡挫折過,
沒想到換這麼多版本了還是沒變,
看來微軟是打算錯到底了.

接著,如果Data有新增資料也要即時加入Dictionary裡以方便後續使用.
===Data 的 Worksheet_Change===

1.   With Target
   
2.     If .Column = 8 Then
   
3.       dShi(.Text) = .Row
   
4.       ' 如果清掉 SHIPMENT REF 要刪除整列資料
   
5.       Application.EnableEvents = False ' 變更資料中,關閉觸發Change程序
   
6.         If .Text = "" Then Rows(.Row).Delete
   
7.       Application.EnableEvents = True ' 資料變更完畢,恢復可觸發Change程序
   
8.     End If
   
9.   End With

複製代碼

再來,要記錄Checking資料最末列,
以便後續添加資料.
===Module1===

1. Public lShrRow&

複製代碼

===ThisWorkBook 的 Workbook_Open===

1.   lShrRow = shShr.Cells(Rows.Count, 1).End(xlUp).Row

複製代碼

前置作業完畢,接著就是重頭戲了.
===Checking 的 Worksheet_Change===

1. Dim rTar As Range ' 填資料標的儲存格A欄
   
2.   
   
3.   With Target
   
4.     If .Address = "$A$2" Then
   
5.       lRow = dShi(.Text)
   
6.       Application.EnableEvents = False ' 變更資料中,關閉觸發Change程序
   
7.         .Offset(, 1) = shDat.Cells(lRow, 1) ' B2
   
8.         .Offset(, 2) = shDat.Cells(lRow, 6) ' C2
   
9.         ' 其餘請自行調整填入
   
10.         
    
11.         lShrRow = lShrRow + 1
    
12.         Set rTar = shShr.Cells(lShrRow, 1) ' [A末筆欄數]
    
13.         With rTar
    
14.           .Offset(-1).Resize(, Columns.Count - 1).Copy ' 複製上一行的儲存格
    
15.           .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone ' 貼上格式
    
16.           .Value = Date ' 今天日期-A欄
    
17.         End With
    
18.         rTar.Offset(, 19) = .Offset(, 0) 'T欄
    
19.         rTar.Offset(, 17) = .Offset(, 1) 'R欄
    
20.         rTar.Offset(, 14) = .Offset(, 2) 'O欄
    
21.         ' 其餘請自行調整填入
    
22.         
    
23.         .Resize(, Columns.Count - 1).Clear ' 清掉輸入區整行資料等待輸入下一筆
    
24.       Application.EnableEvents = True ' 資料變更完畢,恢復可觸發Change程序
    
25.     End If
    
26.   End With

複製代碼

當然還有改善的空間,
那就要靠你自己努力了.
test abc recv - ANS.zip (58.82 KB)

下載次數: 12

2019-3-2 07:22

john2006168

回復 2# luhpro

很多謝您詳細的注解和分析，令我獲益良多，十分感謝。

john2006168

回復 2# luhpro


    很多謝老師的幫忙,test後, Sheets("Checking")下列的資料不可以update到shipment record相對的位置.另外是否可以不立刻清除scan的資料,方便檢查,請老師再次幫忙
ITEM NO        BATCH NO        CUSTOMER CODE
1        1901387        JN1G
2        1901387        JN1G
3        1901387        JN1G
4        1901387        JN1G
5        1901387        JN1G
6        1901387        JN1G

john2006168

回復 2# luhpro

john2006168

回復 2# luhpro

luhpro

回復  luhpro
john2006168 發表於 2019-3-5 12:53

先說一點,
你說不要立刻清除scan的資料,
那就把那一行改放到開始產生索引資料指令的前面,
並記得不要清到 A2 裡剛剛輸入的資料即可:

先刪掉這一行 :

1. .Resize(, Columns.Count - 1).Clear ' 清掉輸入區整行資料等待輸入下一筆

複製代碼

再將該行調整內容改成底下這樣 :

1. ...
   
2.       Application.EnableEvents = False ' 變更資料中,關閉觸發Change程序
   
3.         .Offset(, 1).Resize(, Columns.Count - 2).Clear ' 清掉輸入區整行資料等待輸入下一筆
   
4.         .Offset(, 1) = shDat.Cells(lRow, 1) ' B2
   
5. ...

複製代碼

===================================================
接著回應你的問題 :

所以這就是看不懂你例子的地方.
你是要從 Data 裡索引出需要的資料,
先存在  Checking 裡的 A2,
再放進  shipment record 裡,
那跟 A6 開始的資料不知道有什麼關係?

首先,你 Checking 裡 A6 開始的那18列資料,
是你從 Data 索引出來給 shipment record 用的嗎?
可是你的 Data 裡沒有可以對照的資料,
不知道是怎麼產生出 A6 的那些資料.

再則,索引過程中的資料都是放在 A2,
看不出來跟 A6 裡的資料怎麼交集?

其次, 在 shipment record 裡 BATCH NO 是 1901387 的只有一筆資料,
但你 Checking 裡 A6 區裡是有多筆的.
所以需要先釐清的是你只需要產生一筆資料,還是多筆資料?
如果是一筆資料, 那麼必然是有需相加的值(那麼要針對這幾欄做與目前值相加),
反之,那麼就是要插入新列(因是插入列, 後續索引要重建, 也因要索引, 這些資料鍵值也不能相同).

因為兩者的處理方式差異滿大的(包含後續作業),
你的例子若怕洩密,
部分資料可以酌量Mark起來(只要不影響實際處理結果即可)
例子資料需要夠多至少要能含括大部分的差異,
例子不可以都是相同的資料內容,
這樣無法建立一對一的索引(會出現後蓋前的情形))
以上所說需要先釐清楚,
才好進行後續作業.

john2006168

回復 7# luhpro

多謝你的幫忙,其他問題已經自己可以完成,現在想問一下,如果scan的資料,怎麼copy到 E7的位置??

下載 (291.98 KB)

2019-3-10 23:22