- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
試試看:- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim MH, RngB As Range, Rng2 As Range
- Set RngB = [B3:B65536] '輸入區
- Set Rng2 = [C2:O2] '比對區
- If Target.Count > 1 Then Exit Sub '如果兩格以上同時Change,跳出
- If Not Intersect(Target, RngB) Is Nothing Then '如果 Target 與 比對區 有交集
- If Target = "" Then
- Cells(Target.Row, "B").Resize(1, 14) = "" '如果Change的是空白,清除該列
- End If
- MH = Application.Match(Target, Rng2, 0) '在比對區找出 Target 在第2列的位置
- If IsNumeric(MH) Then '如比對成功傳回在比對的列數, 否則傳回錯誤訊息
- '故先用 IsNumeric(MH) 判斷MH是否為數字
- Cells(Target.Row, MH + 2) = 1 '若有符合,填入1
- End If
- End If
- End Sub
複製代碼 |
|