输入逐步提示信息VBA编程请教
我的编程以下，其中有错误，但不知道如何修改，请各位大师帮忙，谢谢。
（注：本编程效果：在录入表只要输入一个汉字或字母就会出现一个提示框，从提示框中可以选择所要输入数据表中内容。）
1、模块1：
Public Function lchin(str As String) As Variant
On Error Resume Next
str = StrConv(str, vbNarrow)
If Asc(str) > 0 Or Err.Number = 1004 Then lchin = ""
lchin = WorksheetFunction.VLookup(str, [{"吖","a";"八","b";"嚓","c";"打","d";"鹅","e";"发","f";"嘎","g";"哈","h","加","j";"喀","k";"啦","L";"吗","M";"那","N";"哦","O";"怕","P";"日","R";"撒","S";"他","T";"哇","W";"呀","Y";"砸","Z"}])
End Function
2、sheet1(录入表）
Option Explicit
Private Sub listbox1_dblclick(ByVal cancel As msforms.returninteger, ByVal shift As Integer)
ActiveCell.Value = listbox1.Value
Me.listbox1.Clear
Me.textbox1 = ""
Me.listbox1.Visible = False
Me.textbox1.Visible = False
End Sub
Private Sub textbox1_keyup(ByVal keycode As msforms.returninteger, ByVal shift As Integer)
Dim i As Integer
Dim language As Boolean
Dim mystr As String
Me.listbox1.Clear
With Me.textbox1
For i = 1 To ten(Value)
If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
language = ture
mystr = mystr & Mid$(Value, i, 1)
Else
mystr = mystr & lcale(Mid$(Value, i, 1))
End If
Next
End With
With Sheet2
For i = 2 To .Range("a65536").End(xlUp).Row
If language = ture Then
If Left(Cells(i, 1).Value, Len(mystr)) = mystr Then
Me.listbox1.AddItem .Cells(i, 1).Value
End If
Else
If Left(Cells(i, 2), Value, Len(mystr)) = mysty Then
Me.listbox1 .AddItem.Cells(i, 1).Value
End If
End If
Next
End With
End Sub
Private Sub worksheet_selectionchange(ByVal target As Range)
Dim i As Integer
If target.colunt = 1 Then
If target.Column = 1 And targe.Row > 1 Then
With Me.textbox1
.Visible = True
.Top = target.Top
.Left = target.Left
.Width = target.Width
.Height = target.Height
End With
With Me.listbox1
.Clear
.Visible = True
.Top = target.Top
.Left = target.Left + target.Width
.Width = target.Width
.Height = target.Height * 5
For i = 2 To Sheet2.Range("a65536").End(xlUp).Row
.AddItem Sheet2.Cells(i, 1).Value
Next
End With
Else
Me.listbox1.Clear
Me.textbox1 = ""
Me.listbox1.Visible = False
Me.textbox1.visile = False
End If
End If
End Sub
End Sub
3、sheet2(数据表）
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
Dim i As Integer
Dim mystr As String
With target
If .Column <> 1 Or .Count > 1 Then Exit Sub
If .WorksheetFunction.CountIf(Sheet2.Range("A:A"), .Value) > 1 Then
.Value = ""
MsgBox "不能输入重复的产品名称", 64
Exit Sub
End If
For i = 1 To Len(.Value)
If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
mystr = mystr & lchin(Mid$(.Value, i, 1))
Else
mystr = mystr & LCase(Mid$(.Value, i, 1))
End If
Next
.Offset(, 1).Value = mystr
End With
End Sub
------解决方案--------------------------------------------------------
你的代码是太多错误了～例如在with里的value没有“.”，函数名错误……我帮你改了一下，能跑起来了。
模块一没问题；
sheet1表：
Option Explicit
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCell.Value = ListBox1.Value