- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-12-5
|
6#
發表於 2022-11-23 09:52
| 只看該作者
回復 5# av8d
恭喜前輩
後學有試成功:
後學有個想法:
防止觸發再觸發,不知道正不正確??
請前輩們指導!謝謝
1.前方加 Application.EnableEvents = False:觸發失效
2.後方加Application.EnableEvents = True:觸發啟動
3.Application.EnableEvents = True: Exit Sub:離開前觸發啟動
原程式碼添加如下:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Left(Target.Address(0, 0), 1) = "A" Then
ElseIf Left(Target.Address(0, 0), 1) = "B" Then
If Cells(Target.Row, 2) = "貼上文號" Then
[B1] = ""
For i = 0 To 5000
If Cells(3 + i, 2) = "" Then
Cells(3 + i, 2).Select
ActiveSheet.PasteSpecial xlPasteValues
[B1] = "完成"
'判斷是否重複複製
If Cells(3 + i, 2) = Cells(2 + i, 2) Then
[B1] = "重複複製"
Cells(3 + i, 2) = ""
End If
Application.EnableEvents = True: Exit Sub
End If
Next
End If
ElseIf Left(Target.Address(0, 0), 1) = "C" Then
If Cells(Target.Row, 3) = "貼上名字" Then Application.EnableEvents = True: Exit Sub
ElseIf Left(Target.Address(0, 0), 1) = "D" Then
If Cells(Target.Row, 4) = "搜尋文號 ↑↑↑" Then [D1].Select
ElseIf Left(Target.Address(0, 0), 1) = "E" Then
If Cells(Target.Row, 5) = "複製文號" Then [D1].Select
ElseIf Left(Target.Address(0, 0), 1) = "F" Then
If Cells(Target.Row, 6) = "複製名字" Then [D1].Select
ElseIf Left(Target.Address(0, 0), 1) = "G" Then
If Cells(Target.Row, 7) = "搜尋名字 ↑↑↑" Then [G1].Select
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address(0, 0) = "D1" Then
If [D1] = "" Then ActiveSheet.Range("E2").AutoFilter Field:=1: Application.EnableEvents = True: Exit Sub
[G1] = ""
'搜尋文號
Range("E2").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
ActiveWindow.ScrollRow = 1
ElseIf Target.Address(0, 0) = "G1" Then
If [G1] = "" Then ActiveSheet.Range("F2").AutoFilter Field:=2: Application.EnableEvents = True: Exit Sub
[D1] = ""
'搜尋名字
Range("G2").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
ActiveWindow.ScrollRow = 1
End If
Application.EnableEvents = True
End Sub |
|
