|
可以加几句代码:清除同一行后面的数据
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Dim sj(), nL%, cTxt$, nRow%, Arr(), ds As Object
- Set ds = CreateObject("Scripting.Dictionary")
-
- If Target.Row = 1 Or Target.Column > 4 Or Target.CountLarge > 1 Then Exit Sub
- nL = Target.Column
- Select Case nL
- Case 1
- Target.Offset(0, 1).Resize(1, 3).ClearContents
- Case 2
- Target.Offset(0, 1).Resize(1, 2).ClearContents
- Case 3
- Target.Offset(0, 1).ClearContents
- End Select
- sj = Range("a" & Target.Row).Resize(1, 3).Value
- With Sheets("基础")
- nRow = .Cells(999, nL).End(xlUp).Row
- Arr = .Range("a1").Resize(nRow, nL).Value
- End With
- For i = 2 To nRow
- For j = 1 To nL - 1
- If Arr(i, j) <> sj(1, j) Then Exit For
- Next
- If j = nL And Not ds.exists(Arr(i, nL)) Then
- ds(Arr(i, nL)) = ""
- cTxt = cTxt & "," & Arr(i, nL)
- End If
- Next
- With Target.Validation
- .Delete
- If cTxt <> "" Then .Add 3, 1, 1, Mid(cTxt, 2)
- End With
-
- End Sub
复制代码 |
评分
-
3
查看全部评分
-
|