- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, M
With Target
If .Column <> 2 Or .Columns.Count > 1 Then Exit Sub '非第2欄,或選取兩欄以上,跳出
On Error GoTo 999 '發生錯誤時,執行標記999那行程式
Application.EnableEvents = False '關閉事件觸發
For Each xR In .Cells '歷遍選取區全部儲存格(可使用貼上多個)
If xR.Row > 2 Then
xR(1, 2).Resize(1, 99).ClearContents '清除右方原有資料
M = Application.Match(xR, [2:2], 0) '找出Item在第2列的位置
If IsNumeric(M) Then xR(1, M - 1) = 1 '若有符合,填入1
End If
Next
End With
999: Application.EnableEvents = True '恢復事件觸發
End Sub |
|