- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 106
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-5-8
              
|
回復 8# mistery
不建議這樣做法- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim A As Range, B As Range, Rng As Range, MyStr$
- If Target.Count > 1 Then Exit Sub
- Application.EnableEvents = False
- If Target.Column = 1 And Target = "" Then
- Target.EntireRow = "" '整列清空
- ElseIf Target.Column = 1 And Target <> "" Then
- Set A = Sheet2.Columns("A").Find(Target, lookat:=xlWhole)
- k = Application.CountA(A.EntireRow)
- MyStr = Join(Application.Transpose(Application.Transpose(A.Offset(, 1).Resize(, k - 1))), ",")
- With Target.Offset(, 1).Validation
- .Modify 3, , , MyStr
- End With
- ElseIf Target.Column = 2 And Target <> "" Then
- Set A = Sheet3.Columns("A").Find(Target.Offset(, -1), lookat:=xlWhole)
- Set B = Sheet3.Columns("A:B").Find(Target, after:=A, lookat:=xlWhole)
- Set Rng = Sheet3.Range(B.Offset(, 1), B.End(xlToRight))
- If Rng.Count = 1 Then MyStr = Rng Else MyStr = Join(Application.Transpose(Application.Transpose(Rng)), ",")
- With Target.Offset(, 1).Validation
- .Modify 3, , , MyStr
- End With
- End If
- Application.EnableEvents = True
- End Sub
|
|
發表於 2010-12-21 15:16
| 
