会计凭证的录入

cut

请问如何单元格不重复值录入呢？在不使用控件listbox+textbox的条件下
像单元格下有效性一样

wlmhit903

单元格下有效性就是很好的办法

3190496160

Private Sub Worksheet_Change(ByVal T As Range)
If T.Row > 4 And T.Column = 2 And T.Row < 15 Then
Dim dc As Object
Set dc = CreateObject("scripting.dictionary")
    If T.Count > 1 Then End
    If T.Value = "" Then End
    With Sheet1
        ar = .Range("a2:b" & .[b65536].End(xlUp).Row)
    End With
    If T.Row > 5 Then
        sl = Application.CountIf(Range("b5:b" & T.Row), T.Value)
        If sl > 1 Then T.Value = "": End
    End If
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) = Trim(T.Value) Then
            If Trim(ar(i, 2)) <> "" Then
                dc(Trim(ar(i, 2))) = ""
            End If
        End If
    Next i
    If dc.Count = 0 Then End
    With T.Offset(, 1).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=Join(dc.keys, ",")
   End With
   T.Offset(, 1).Select
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal T As Range)
Dim arr, i
If T.Row > 4 And T.Column = 2 And T.Row < 15 Then
    If T.Count > 1 Then End
    With T
        With Sheet1
            arr = .Range("a2:b" & .[b65536].End(xlUp).Row)
        End With
        Set d = CreateObject("scripting.dictionary")
        For i = 1 To UBound(arr)
            If Trim(arr(i, 1)) <> "" Then d(arr(i, 1)) = ""
        Next
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Join(d.keys, ",")
        End With
    End With
End If
End Sub

3190496160

1、不重复值录入.rar (22.51 KB, 下载次数: 61)

2022-7-2 08:08 上传

点击文件名下载附件

cut

谢谢3190496160解答，问题解决了，感谢