實作效果如圖：
直接上碼：
Public serachedRowIndex As Integer
Private Sub CommandButton2_Click()
LoadStandardData
End Sub
'下拉框雙擊事件
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.TopLeftCell = ListBox1.List(ListBox1.ListIndex, 2)
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column - 1) = ListBox1.List(ListBox1.ListIndex, 1)
TextBox1.TopLeftCell(2, 1).Select
End Sub
'下拉框按鍵處理
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
If KeyCode = 8 Then
TextBox1.Activate
End If
If KeyCode = 13 Then '按下回車
If ListBox1.ListCount > 0 Then
TextBox1.Visible = False
'If ListBox1.Text = "" Then ListBox1.ListIndex = 0
TextBox1.TopLeftCell = ListBox1.List(ListBox1.ListIndex, 2)
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column - 1) = ListBox1.List(ListBox1.ListIndex, 1)
TextBox1.TopLeftCell(2, 1).Select
KeyCode = 0
End If
End If
If KeyCode = 27 Then 'Esc
TextBox1.Visible = False
ListBox1.Visible = False
End If
If KeyCode = 37 Then '方向左
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column - 1).Select
End If
If KeyCode = 38 And ListBox1.ListIndex = 0 Then '方向上
Me.TextBox1.Activate
End If
If KeyCode = 39 Then '方向右
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column + 1).Select
End If
End Sub
'文本框按鍵事件
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
With TextBox1
Select Case KeyCode
Case 13 '回車
.TopLeftCell = ListBox1.List(ListBox1.ListIndex, 2)
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column - 1) = ListBox1.List(ListBox1.ListIndex, 1)
If ListBox1.ListIndex = -1 Then
.TopLeftCell = ""
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column - 1) = ""
End If
.TopLeftCell(2, 1).Select
KeyCode = 0
Case 40 '向下
ListBox1.Activate
Case 27 'Esc
TextBox1.Visible = False
ListBox1.Visible = False
Selection.Select
Case 37 '方向左
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column - 1).Select
Case 38 '方向上
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 2, TextBox1.TopLeftCell(2, 1).Column).Select
Case 39 '方向右
Sheets("待對碼表").Cells(TextBox1.TopLeftCell(2, 1).Row - 1, TextBox1.TopLeftCell(2, 1).Column + 1).Select
End Select
End With
End Sub
'文本框按鍵事件
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If ListBox1.ListCount <> Sheets("標準碼表").Range("A65536").End(3).Row - 1 Then
'資料不一致時，重新加載
LoadStandardData
Else
If TextBox1.Text = "" Then
ListBox1.ListIndex = -1
serachedRowIndex = 0
GoTo exitFlag
End If
'------------------------
'第一次，正向檢索
'------------------------
For j = serachedRowIndex To ListBox1.ListCount - 1 'Sheets("標準碼表").Range("A65536").End(3).Row
'------
'首先精確查找，找不到再模糊查找
'------
S = ListBox1.List(j, 3) '拼音碼
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then
ListBox1.ListIndex = j
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
S = ListBox1.List(j, 1) '編碼
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then '拼音碼
ListBox1.ListIndex = j
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
S = ListBox1.List(j, 2) '名稱
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then '拼音碼
ListBox1.ListIndex = j
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
S = ListBox1.List(j, 0) '序號
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then '序號
ListBox1.ListIndex = j
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
Next j
'-------------
'逆向精確查找
'-------------
For i = serachedRowIndex To 0 Step -1
'------
'首先精確查找，找不到再模糊查找
'------
S = ListBox1.List(i, 3) '拼音碼
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then
ListBox1.ListIndex = i
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
S = ListBox1.List(i, 1) '編碼
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then '拼音碼
ListBox1.ListIndex = i
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
S = ListBox1.List(i, 2) '名稱
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then '拼音碼
ListBox1.ListIndex = i
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
S = ListBox1.List(i, 0) '序號
If InStr(1, S, UCase(TextBox1.Value)) = 1 Then '序號
ListBox1.ListIndex = i
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
End If
Next i
'-------------
'逆向查找結束
'-------------
'------
'精確查找結束,如果還沒找到（ListIndex=-1）則繼續模糊查找
'------
For k = serachedRowIndex To ListBox1.ListCount - 1
'編碼|拼音碼|名稱|序號
S = ListBox1.List(k, 1) & "|" & ListBox1.List(k, 3) & "|" & ListBox1.List(k, 2) & "|" & ListBox1.List(k, 0)
If (InStr(1, S, UCase(TextBox1.Value))) Then
ListBox1.ListIndex = k
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
Else
ListBox1.ListIndex = -1
End If
Next k
'------------------------
'如果serachedRowIndex之后沒有，再逆向向前檢索
'------------------------
For l = serachedRowIndex To 0 Step -1
'編碼|拼音碼|名稱|序號
S = ListBox1.List(l, 1) & "|" & ListBox1.List(l, 3) & "|" & ListBox1.List(l, 2) & "|" & ListBox1.List(l, 0)
If (InStr(1, S, UCase(TextBox1.Value))) Then
ListBox1.ListIndex = l
serachedRowIndex = ListBox1.ListIndex
GoTo exitFlag
Else
ListBox1.ListIndex = -1
End If
Next l
'-------------------------
End If
exitFlag:
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Cells(1, ActiveCell.Column) = "檢索碼" And Target.Count = 1 And Target.Row <> 1 Then
TextBox1.Activate
TextBox1.Visible = True
ListBox1.Visible = True
TextBox1 = ""
TextBox1.Top = Target.Top
TextBox1.Left = Cells(ActiveCell.Row, ActiveCell.Column).Left
ListBox1.Top = Target.Top + 15
ListBox1.Left = Cells(ActiveCell.Row, ActiveCell.Column).Left
'加載資料
LoadStandardData
Else
TextBox1 = ""
ListBox1.Visible = False
TextBox1.Visible = False
End If
End Sub
Private Sub LoadStandardData()
If ListBox1.ListCount <> Sheets("標準碼表").Range("A65536").End(3).Row - 1 Then
ListBox1.Clear
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "38 磅,49.95 磅;160 磅;49.95 磅"
ListBox1.ColumnHeads = False
'從第二行（A2）開始到資料區末尾添加資料
ListBox1.List = Sheets("標準碼表").Range("A2:D" & Sheets("標準碼表").Range("A65536").End(3).Row).Value
End If
End Sub
Private Sub Worksheet_Activate()
'MsgBox "sfasd"
End Sub
uj5u.com熱心網友回復：
這是求助的，還是分享的？uj5u.com熱心網友回復：
這是VBA里的代碼，難道題主想轉成用VB實作？轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/112485.html
標籤：VBA