Summary of the smart prompting function implemented by Excel using VBA

:

 

 

1. Enter the development tool Mode

Because I have never used Excel Development before, it takes some time to find EXCEL to add controls.

 

2. Add two ActiveX Controls: textbox and ListBox

 

3. Enter the VBA code mode.

Shortcut: Alt + F11

 

4. Code (the specific code is easy to understand)

Considering the convenience of various shortcut keys, you can continue to add features for simple operations.

'Module 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", "a"; "Eight", "B"; "yellow", "C"; "yellow", "D "; "identifier", "E"; "sender", "F"; "identifier", "G ";

"", "H"; "", "J"; "", "K"; "", "L"; "", "M "; "lead", "n"; "Oh", "O"; "lead", "P"; "seven", "Q"; "lead", "R "; "yellow", "S"; "he", "T"; "yellow", "W"; "Xi", "x"; "ya", "Y "; "Begin", "Z"}], 2) end Function

 

'Input table private sub listboxmongodblclick (byval cancel as msforms. returnboolean) dim R1 activecell. value = listbox1.value me. listbox1.clear me. textbox1 = "" me. listbox1.visible = false me. textbox1.visible = false if Col = 2 then set R1 = sheet8.range ("A: "). find (activecell. value, xlwhole) activecell. offset (0, 7) = sheet8.cells (r1.row, 0 ). value elseif Col> 2 and Col <6 then set R1 = sheet8.range ("C: C "). find (activecell. value, xlwhole) activecell. offset (0, 7) = sheet8.cells (r1.row, 2 ). value elseif Col> 5 and Col <8 then set R1 = sheet8.range ("E: e "). find (activecell. value, xlwhole) activecell. offset (0, 7) = sheet8.cells (r1.row, 4 ). value elseif Col> 7 and Col <18 then set R1 = sheet8.range ("G: G "). find (activecell. value, xlwhole) activecell. offset (0, 7) = sheet8.cells (r1.row, 6 ). value elseif Col> 17 and Col <21 then set R1 = sheet8.range ("I: I "). find (activecell. value, xlwhole) activecell. offset (0, 7) = sheet8.cells (r1.row, 8 ). value end ifend subprivate sub listbox1_keydown (byval keycode as msforms. returninteger, byval shift as integer) If keycode = vbkeyreturn or keycode = vbkeytab then activecell. value = listbox1.value me. listbox1.clear me. textbox1 = "" me. listbox1.visible = false me. textbox1.visible = false end if keycode = vbkeyleft then sheet3.textbox1. activate end ifend subprivate sub listboxinclugotfocus () on error resume next listbox1.listindex = 0end subprivate sub textbox#keydown (byval keycode as msforms. returninteger, byval shift as integer) If keycode = vbkeyreturn or keycode = vbkeytab or keycode = vbkeyup or keycode = vbkeydown or keycode = vbkeyright then sheet3.listbox1. activate end if keycode = vbkeydelete then activecell. value = "" me. listbox1.clear me. textbox1 = "" me. listbox1.visible = false me. textbox1.visible = false end if keycode = vbkeyescape then me. listbox1.clear me. textbox1 = "" me. listbox1.visible = false me. textbox1.visible = false End ifend subprivate sub textbox1_keyup (byval keycode as msforms. returninteger, byval shift as integer) dim I as integer dim language as Boolean dim mystr as string, strtext $, N1 & me. listbox1.clear with me. textbox1 for I = 1 to Len (. value) If ASC (mid $ (. value, I, 1)> 255 or ASC (mid $ (. value, I, 1) <0 then language = true mystr = mystr & Mid $ (. value, I, 1) else mystr = mystr & lcase (mid $ (. value, I, 1) end if next end with sheet8 if Col = 2 then for I = 2. range ("a65536 "). end (xlup ). row If language = true then n1 = instr (. cells (I, 1), mystr) If N1> 0 then me. listbox1.additem. cells (I, 1 ). value end if else n1 = instr (. cells (I, 2), mystr) If N1> 0 then me. listbox1.additem. cells (I, 1 ). value end if next elseif Col> 2 and Col <6 then for I = 2. range ("c65536 "). end (xlup ). row If language = true then n1 = instr (. cells (I, 3), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if else n1 = instr (. cells (I, 4), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if next elseif Col> 5 and Col <8 then for I = 2. range ("e65536 "). end (xlup ). row If language = true then n1 = instr (. cells (I, 5), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if else n1 = instr (. cells (I, 6), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if next elseif Col> 7 and Col <18 then for I = 2. range ("g65536 "). end (xlup ). row If language = true then n1 = instr (. cells (I, 7), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if else n1 = instr (. cells (I, 8), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if next elseif Col> 17 and Col <21 then for I = 2. range ("i65536 "). end (xlup ). row If language = true then n1 = instr (. cells (I, 9), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if else n1 = instr (. cells (I, 10), mystr) If N1> 0 then me. listbox1.additem. cells (I, 3 ). value end if next end if end withend subprivate sub worksheet_selectionchange (byval target as range) dim I as integer if target. count> 1 then exit sub if target. row <2 then exit sub if target. column <2 or target. column> 22 then exit sub me. listbox1.clear Col = target. column with me. textbox1. visible = true. top = target. top. left = target. left. width = target. width. height = target. height. activate end with me. listbox1. visible = true. top = target. top. left = target. left + target. width. width = target. width. height = target. height * 5 end with '======================================== ========================================================== = ''Based on the clicked text box, intelligently display the corresponding ListBox correspondence: 'column = 2 ----------> region cells = 1' column = 3-5 ---------> catering cells = 3 'column = 6-7 ---------> accommodation cells = 5' column = 8-17 --------> scenic spots cells = 7'column = 18-20 -------> shopping point cells = 9'' ================ ========================================================== ==================== if target. column = 2 then with me. listbox1 for I = 2 to sheet8.range ("a65536 "). end (xlup ). row. additem sheet8.cells (I, 1 ). value next end with elseif target. column> 2 and target. column <6 then with me. listbox1 for I = 2 to sheet8.range ("c65536 "). end (xlup ). row. additem sheet8.cells (I, 3 ). value next end with elseif target. column> 5 and target. column <8 then with me. listbox1 for I = 2 to sheet8.range ("e65536 "). end (xlup ). row. additem sheet8.cells (I, 5 ). value next end with elseif target. column> 7 and target. column <18 then with me. listbox1 for I = 2 to sheet8.range ("g65536 "). end (xlup ). row. additem sheet8.cells (I, 7 ). value next end with elseif target. column> 17 and target. column <21 then with me. listbox1 for I = 2 to sheet8.range ("i65536 "). end (xlup ). row. additem sheet8.cells (I, 9 ). value next end with else me. listbox1.clear me. textbox1 = "" me. listbox1.visible = false me. textbox1.visible = false end if end sub

 

'Data table private sub worksheet_change (byval target as range) dim I as integer dim mystr as string with target if. column <> 5 or. count> 1 then exit sub if worksheetfunction. countif (sheet3.range ("A: "),. value)> 1 then. value = "" msgbox "cannot enter duplicate enterprise names! ", 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