返回列表 上一主題 發帖

儲存格比對後.導入滑鼠位置問題2

儲存格比對後.導入滑鼠位置問題2

各位 前輩先進 大家好

有2提問請教.因同一工作表.可請一問題指導

問題一)儲存格比對後.導入滑鼠位置
需求:如何將滑鼠點進"P2"儲存格中.以"P2"儲存格中資料去
         比對"K2"儲存格第1筆資料後.
        滑鼠位置導入所比對第1筆資料後"E欄"儲存格中.
        並將黑色字體轉換成紅色字體.離開後恢復黑色字體
        例1)點進1100601001後.比對"K欄".得1100601001第1筆資料位置在"E2".滑鼠位置會在"E2"
        例2)點進1100601005後已對"K欄".得1100601005第1筆資料位置在"E18".滑鼠位置會在"E18"
        例3)點進1100602005後比對"K欄".得1100602005第1筆資料位置在"E178".滑鼠位置會在"E178"

問題二)小計是否可同步更新
       小計"M欄"中以主程式導入資料產生.因"E欄"中需修改數量
       導至"H欄"中變化產生資料變異
       .而小計是主程式以單號"K欄"總和故無法同步更新
       現以"H1"中程式往下拉.可將"E欄"中變化而同步變更.
       而小計是以"K欄"單號中筆數為總和.故無法同步更新

需求: 是否可用VBA比對方式.以同筆數"K欄"筆數再以"H欄"筆數總和更改為小計總和


    感謝大家指導   

儲存格位置導入(1).zip (76.81 KB)
敏而好學,不恥下問

回復 1# BV7BW

儲存格位置導入 v1.zip (77.85 KB)

TOP

本帖最後由 BV7BW 於 2021-6-24 06:11 編輯

回復 2# singo1232001
非常感謝 singo1232001 大大 指導
對於第一問題指導
非常完全圓滿軵和所需.謝謝你

PS:是否可在幫注解.我可加快理解 singo1232001 大大 指導
  謝謝
敏而好學,不恥下問

TOP

本帖最後由 singo1232001 於 2021-6-24 06:45 編輯
  1. Private Sub Worksheet_Change(ByVal Target As Range)   '儲存格改變時才會觸發 target 就是你原先變更資料的儲存格(不是新選到的)
  2. If Target.Count > 1 Then Exit Sub '選到兩格以上 強制結束(跑下去會出問題,本sub內的提到的"選到的格子"皆為尚未點擊之前選到的格子)
  3. If Target.Column <> 5 Then Exit Sub '選到不是第五欄 強制結束(跑下去會出問題)
  4. If Target.Row = 1 Then Exit Sub    '選到第一列 強制結束(跑下去會出問題)
  5. If Target.Value = "" Then Exit Sub '選到格子內無任何資料 強制結束(跑下去會出問題)

  6. Target.Font.ColorIndex = xlAutomatic '顏色變回黑

  7. Set s = ActiveSheet  '將工作表縮寫 後面使用縮寫方便
  8. On Error Resume Next '允許發生錯誤 不再跳出提示錯誤警告視窗
  9. f = 0              
  10. f = s.Columns("A:M").Find("*", searchdirection:=2).Row  '查找最後一列 , "*" 找尋A~M欄非空白有資料的格子 searchdirection:=2由下往上查找
  11. If f = 0 Then Exit Sub                '如果f還是0 代表沒資料 不跑
  12. On Error GoTo 0             '不允許發生錯誤 回復成提示錯誤警告視窗

  13. k = s.Cells(Target.Row, "K")  '查找該同一列的 k欄值
  14. x = 0  '紀錄加總用的x
  15. For i = 2 To f   '迴圈  (從第二列找到 最後一列)
  16. If Str(k) = Str(s.Cells(i, "K")) Then x = x + s.Cells(i, "H")   '找到相同的產品編號 將H欄值持續加總到x
  17. Next
  18. '到這邊已經加總完全同一個編號的數量
  19. Application.EnableEvents = False  '關閉事件觸發 以免連續影響 其他的觸發事件 selection 與 change
  20. For i = 2 To f
  21. If Str(k) = Str(s.Cells(i, "K")) Then s.Cells(i, "M") = x     '找到相同的產品編號 並且將加總好的x放到同一列的M欄
  22. Next
  23. Application.EnableEvents = True '重新開啟事件觸發
  24. Set s = Nothing  

  25. End Sub

  26. Private Sub Worksheet_SelectionChange(ByVal Target As Range) '儲存格點選時才會觸發 target 就是你當下點的儲存格(新選到的)
  27. If Target.Count > 1 Then Exit Sub '選到兩格以上 強制結束(跑下去會出問題)
  28. If Target.Row = 1 Then Exit Sub '選到第一列 強制結束(跑下去會出問題)
  29. If Target.Value = "" Then Exit Sub '選到格子內無任何資料 強制結束(跑下去會出問題)

  30. If Target.Column <> 16 Then Exit Sub '選到不是第P欄 強制結束(跑下去會出問題)

  31. Set s = ActiveSheet   '將工作表縮寫 後面使用縮寫方便
  32. On Error Resume Next '允許發生錯誤 不再跳出提示錯誤警告視窗
  33. f = 0
  34. f = s.Columns("K").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=1).Row  'searchdirection:=1由上往下查找 只找K欄 找到相同的編號
  35. If f = 0 Then Exit Sub '找不到符合項目 強制結束(跑下去會出問題)
  36. On Error GoTo 0

  37. Application.EnableEvents = False '關閉事件觸發
  38. s.Cells(f, "E").Select  '點選 找到的儲存格
  39. s.Cells(f, "E").Font.Color = -16776961 '並將顏色改為紅
  40. SendKeys "{F2}"   '並進入修改模式  f2本身為excel的 功能
  41. Application.EnableEvents = True  '重新開啟事件觸發
  42. Set s = Nothing
  43. End Sub
複製代碼
回復 3# BV7BW

TOP

回復 4# singo1232001

再次謝謝  singo1232001 大大
剛剛只測試問題一).沒注意到問題二)也非常成功
又謝謝你幫注解.我再理解作法
謝謝 singo1232001 大大指導
敏而好學,不恥下問

TOP

SelectionChange 會讓P欄沒辦法做更改,
可以改用 BeforeRightClick 雙按左鍵觸發

TOP

本帖最後由 准提部林 於 2021-6-24 13:19 編輯

另一方法:
Xl0000045.rar (63.22 KB)

*P欄第2列以下,雙按滑鼠左鍵,執行查詢及修改,並將同一單號範圍加紅色粗框,
修改數量時,M欄產生的公式會自動計算合值.數量輸入錯誤時,使用復原功能即可.
__使用CHANGE事件是無法做復原的

*修改完成後,在P1雙按左鍵,M欄自動變成值(清除公式),並恢復黑色框線

TOP

回復 7# 准提部林

准大請教一下,那一句用意為何?感謝
Cancel = True

TOP

回復 8# samwang

雙按左鍵, 會進入儲存格為編輯狀態(游標閃爍), 所以要加 cancel=true, 就不會了,

稍改下, 優化M欄合計公式:
Xl0000045-1.rar (63.47 KB)

TOP

本帖最後由 BV7BW 於 2021-6-24 20:21 編輯

回復 9# 准提部林
感謝 准提部林 老師指導
經測試後運轉順暢
尤其"H欄"及"M欄"改造軵和簡便
可請再增列導入後滑鼠位置將黑色字體轉換成紅色字體
離開後不用恢復.以利得知此筆資料已更改過

另一題外題.原是下一發問問題
如何建立當日客戶重複防呆動作並可允許
我先建立檔案再上傳提問
先謝謝 准提部林 老師

儲存格位置導入(1).zip (76.81 KB)

敏而好學,不恥下問

TOP

        靜思自在 : 是非當教育,讚美作警惕。
返回列表 上一主題