输入时逐步提示信息

fcdd

我在sheet6表中L列第四单元格开始《客户(公司)名称》“ 输入时逐步提示信息.rar (12.86 KB, 下载次数: 675)

2012-12-6 14:06 上传

点击文件名下载附件
输入时逐步提示信息

”也在sheet6表中输入下列代码,一运行就说"方法和数据成员未找到"，然后Private Sub Worksheet_SelectionChange(ByVal Target As Range)语句为黄色

注（数据库在sheet35表，“”数据在sheet35表中AB列第五单元开始）
要求1:输入时逐步提示信息
要求2:  模糊提示信息（即输入其中一个“X或N”字，则自动列出含有“X或N”的名称供选择）


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Row < 3 Then Exit Sub
Dim d, i&, Myr&, Arr, cj, cp, jg, r1, n&, ii&
Dim x, cpin$, Myr1&, r%, Arr1(), j&
Myr = Sheet35.[AB65536].End(xlUp).Row
Arr = Sheet35.Range("AB5:AB" & Myr)
col = Target.Column
            Me.ListBox1.Clear
            Me.TextBox1 = ""
            Me.ListBox1.Visible = False
            Me.TextBox1.Visible = False
If Target.Column = 2 Then
    For i = 1 To UBound(Arr)
        cj = cj & Arr(i, 1) & ","
    Next
    cj = Left(cj, Len(cj) - 1)
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=cj
    End With
ElseIf Target.Column = 3 Then
    Myr = Sheet35.[AB65536].End(xlUp).Row
    Arr = Sheet35.Range("AB5:AB" & Myr)
        For i = 1 To UBound(Arr)
            cp = cp & Arr(i, 1) & ","
        Next
        cp = Left(cp, Len(cp) - 1)
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=cp
    End With
ElseIf Target.Column = 4 Or Target.Column = 5 Then
            With Me.TextBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left
                .Width = Target.Width
                .Height = Target.Height + 5
                .Activate
            End With
            With Me.ListBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Height = Target.Height * 10
            End With
        If Target.Column = 4 Then
            With Me.ListBox1
                .List = kc
            End With
        ElseIf Target.Column = 5 Then
            With Me.ListBox1
                .List = kd
            End With
        End If
Else
            Me.ListBox1.Clear
            Me.TextBox1 = ""
            Me.ListBox1.Visible = False
            Me.TextBox1.Visible = False
End If

End Sub

蓝桥玄霜

1. Dim Arr
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3. If Target.Count > 1 Then Exit Sub
   
4. If Target.Row < 5 Then Exit Sub
   
5. Dim Myr&
   
6. Myr = Sheet35.[AB65536].End(xlUp).Row
   
7. Arr = Sheet35.Range("AB5:Ac" & Myr)
   
8. If Target.Column = 12 Then
   
9.     With Me.TextBox1
   
10.         .Visible = True
    
11.         .Top = Target.Top
    
12.         .Left = Target.Left
    
13.         .Width = Target.Width
    
14.         .Height = Target.Height + 5
    
15.         .Activate
    
16.     End With
    
17.     With Me.ListBox1
    
18.         .Visible = True
    
19.         .Top = Target.Top
    
20.         .Left = Target.Left + Target.Width
    
21.         .Height = Target.Height * 10
    
22.     End With
    
23. Else
    
24.     Me.ListBox1.Clear
    
25.     Me.TextBox1 = ""
    
26.     Me.ListBox1.Visible = False
    
27.     Me.TextBox1.Visible = False
    
28. End If
    
29. End Sub
    

复制代码

蓝桥玄霜

控件没有画。
请见附件。

fcdd

蓝桥玄霜 发表于 2012-12-6 14:37
控件没有画。
请见附件。

谢谢，我爱你

蓝桥玄霜

1. 可改为这样：
   
2. 
   
3. Dim Arr
   
4. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
5. If Target.Count > 1 Then Exit Sub
   
6. If Target.Row < 5 Then Exit Sub
   
7. Dim Myr&
   
8. Myr = Sheet35.[AB65536].End(xlUp).Row
   
9. Arr = Sheet35.Range("Aa5:Ab" & Myr)
   
10. If Target.Column = 12 Then
    
11.     With Me.TextBox1
    
12.         .Visible = True
    
13.         .Top = Target.Top
    
14.         .Left = Target.Left
    
15.         .Width = Target.Width
    
16.         .Height = Target.Height + 5
    
17.         .Activate
    
18.     End With
    
19.     With Me.ListBox1
    
20.         .Visible = True
    
21.         .Top = Target.Top
    
22.         .Left = Target.Left + Target.Width
    
23.         .Height = Target.Height * 10
    
24.     End With
    
25. Else
    
26.     Me.ListBox1.Clear
    
27.     Me.TextBox1 = ""
    
28.     Me.ListBox1.Visible = False
    
29.     Me.TextBox1.Visible = False
    
30. End If
    
31. End Sub
    
32. 
    
33. Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
34.     Dim i As Integer
    
35.     Dim Language As Boolean
    
36.     Dim myStr As String
    
37.     Me.ListBox1.Clear
    
38.     With Me.TextBox1
    
39.         For i = 1 To Len(.Value)
    
40.             If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
    
41.                 Language = True
    
42.                 myStr = myStr & Mid$(.Value, i, 1)
    
43.             Else
    
44.                 myStr = myStr & LCase(Mid$(.Value, i, 1))
    
45.             End If
    
46.         Next
    
47.     End With
    
48.     For i = 2 To UBound(Arr)
    
49.         If InStr(Arr(i, 1), LCase(myStr)) > 0 Then
    
50.             Me.ListBox1.AddItem Arr(i, 2)
    
51.         End If
    
52.     Next
    
53. End Sub
    

复制代码

dhf104109

蓝桥玄霜 发表于 2012-12-6 14:37
控件没有画。
请见附件。

请教了，我要改成辅助编码在名称的前一列，怎么改啊？我研究了一早上，还是搞不懂，请教了，谢谢谢谢

qiufu2011

感谢兰版的无私奉献，这个也是我想要的功能！谢谢，学习了

fcdd

输入时逐步提示信息 ,,之后该表不能  Ctrl+C 或 Ctrl+V     鼠标右键复制，粘贴等功能

yutulinfeng

壮哉大兰版！

anmyzhuo

正是需要的，学习，非常感谢