输入逐步提示信息VBA编程指教

fieldset{padding:10px;}

求助:输入逐步提示信息VBA编程指教输入逐步提示信息VBA编程请教我的编程以下,其中有错误,但不知道如何修改,请各位大师帮忙,谢谢。(注:本编程效果:在录入表只要输入一个汉字或字母就会出现一个提示框,从提示框中可以选择所要输入数据表中内容。)1、模块1:Public Function lchin(str As String) As VariantOn Error Resume Nextstr = 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 Function2、sheet1(录入表)Option ExplicitPrivate Sub listbox1_dblclick(ByVal cancel As msforms.returninteger, ByVal shift As Integer)ActiveCell.Value = listbox1.ValueMe.listbox1.ClearMe.textbox1 = ""Me.listbox1.Visible = FalseMe.textbox1.Visible = FalseEnd SubPrivate Sub textbox1_keyup(ByVal keycode As msforms.returninteger, ByVal shift As Integer)Dim i As IntegerDim language As BooleanDim mystr As StringMe.listbox1.ClearWith Me.textbox1For i = 1 To ten(Value)If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Thenlanguage = turemystr = mystr & Mid$(Value, i, 1)Elsemystr = mystr & lcale(Mid$(Value, i, 1))End IfNextEnd WithWith Sheet2For i = 2 To .Range("a65536").End(xlUp).RowIf language = ture ThenIf Left(Cells(i, 1).Value, Len(mystr)) = mystr ThenMe.listbox1.AddItem .Cells(i, 1).ValueEnd IfElseIf Left(Cells(i, 2), Value, Len(mystr)) = mysty ThenMe.listbox1 .AddItem.Cells(i, 1).ValueEnd IfEnd IfNextEnd WithEnd SubPrivate Sub worksheet_selectionchange(ByVal target As Range)Dim i As IntegerIf target.colunt = 1 ThenIf target.Column = 1 And targe.Row > 1 ThenWith Me.textbox1.Visible = True.Top = target.Top.Left = target.Left.Width = target.Width.Height = target.HeightEnd WithWith Me.listbox1.Clear.Visible = True.Top = target.Top.Left = target.Left + target.Width.Width = target.Width.Height = target.Height * 5For i = 2 To Sheet2.Range("a65536").End(xlUp).Row.AddItem Sheet2.Cells(i, 1).ValueNextEnd WithElseMe.listbox1.ClearMe.textbox1 = ""Me.listbox1.Visible = FalseMe.textbox1.visile = FalseEnd IfEnd IfEnd SubEnd Sub3、sheet2(数据表)Option ExplicitPrivate Sub worksheet_change(ByVal target As Range)Dim i As IntegerDim mystr As StringWith targetIf .Column <> 1 Or .Count > 1 Then Exit SubIf .WorksheetFunction.CountIf(Sheet2.Range("A:A"), .Value) > 1 Then.Value = ""MsgBox "不能输入重复的产品名称", 64Exit SubEnd IfFor i = 1 To Len(.Value)If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Thenmystr = mystr & lchin(Mid$(.Value, i, 1))Elsemystr = mystr & LCase(Mid$(.Value, i, 1))End IfNext.Offset(, 1).Value = mystrEnd WithEnd Sub——解决方案——————————————————–你的代码是太多错误了~例如在with里的value没有“.”,函数名错误……我帮你改了一下,能跑起来了。模块一没问题;sheet1表:Option ExplicitPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ActiveCell.Value = ListBox1.Value你在雨中行走,你从不打伞,你有自己的天空,它从不下雨。

输入逐步提示信息VBA编程指教

相关文章:

你感兴趣的文章:

标签云: