- 帖子
- 354
- 主題
- 5
- 精華
- 0
- 積分
- 387
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-8-2
 
|
4#
發表於 2021-6-24 06:31
| 只看該作者
本帖最後由 singo1232001 於 2021-6-24 06:45 編輯
- Private Sub Worksheet_Change(ByVal Target As Range) '儲存格改變時才會觸發 target 就是你原先變更資料的儲存格(不是新選到的)
- If Target.Count > 1 Then Exit Sub '選到兩格以上 強制結束(跑下去會出問題,本sub內的提到的"選到的格子"皆為尚未點擊之前選到的格子)
- If Target.Column <> 5 Then Exit Sub '選到不是第五欄 強制結束(跑下去會出問題)
- If Target.Row = 1 Then Exit Sub '選到第一列 強制結束(跑下去會出問題)
- If Target.Value = "" Then Exit Sub '選到格子內無任何資料 強制結束(跑下去會出問題)
- Target.Font.ColorIndex = xlAutomatic '顏色變回黑
- Set s = ActiveSheet '將工作表縮寫 後面使用縮寫方便
- On Error Resume Next '允許發生錯誤 不再跳出提示錯誤警告視窗
- f = 0
- f = s.Columns("A:M").Find("*", searchdirection:=2).Row '查找最後一列 , "*" 找尋A~M欄非空白有資料的格子 searchdirection:=2由下往上查找
- If f = 0 Then Exit Sub '如果f還是0 代表沒資料 不跑
- On Error GoTo 0 '不允許發生錯誤 回復成提示錯誤警告視窗
- k = s.Cells(Target.Row, "K") '查找該同一列的 k欄值
- x = 0 '紀錄加總用的x
- For i = 2 To f '迴圈 (從第二列找到 最後一列)
- If Str(k) = Str(s.Cells(i, "K")) Then x = x + s.Cells(i, "H") '找到相同的產品編號 將H欄值持續加總到x
- Next
- '到這邊已經加總完全同一個編號的數量
- Application.EnableEvents = False '關閉事件觸發 以免連續影響 其他的觸發事件 selection 與 change
- For i = 2 To f
- If Str(k) = Str(s.Cells(i, "K")) Then s.Cells(i, "M") = x '找到相同的產品編號 並且將加總好的x放到同一列的M欄
- Next
- Application.EnableEvents = True '重新開啟事件觸發
- Set s = Nothing
- End Sub
- Private Sub Worksheet_SelectionChange(ByVal Target As Range) '儲存格點選時才會觸發 target 就是你當下點的儲存格(新選到的)
- If Target.Count > 1 Then Exit Sub '選到兩格以上 強制結束(跑下去會出問題)
- If Target.Row = 1 Then Exit Sub '選到第一列 強制結束(跑下去會出問題)
- If Target.Value = "" Then Exit Sub '選到格子內無任何資料 強制結束(跑下去會出問題)
- If Target.Column <> 16 Then Exit Sub '選到不是第P欄 強制結束(跑下去會出問題)
- Set s = ActiveSheet '將工作表縮寫 後面使用縮寫方便
- On Error Resume Next '允許發生錯誤 不再跳出提示錯誤警告視窗
- f = 0
- f = s.Columns("K").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=1).Row 'searchdirection:=1由上往下查找 只找K欄 找到相同的編號
- If f = 0 Then Exit Sub '找不到符合項目 強制結束(跑下去會出問題)
- On Error GoTo 0
- Application.EnableEvents = False '關閉事件觸發
- s.Cells(f, "E").Select '點選 找到的儲存格
- s.Cells(f, "E").Font.Color = -16776961 '並將顏色改為紅
- SendKeys "{F2}" '並進入修改模式 f2本身為excel的 功能
- Application.EnableEvents = True '重新開啟事件觸發
- Set s = Nothing
- End Sub
|
|
發表於 2021-6-24 12:41
| 
