我有一個 EXCEL 工作表1，工作表1名稱為vip
工作表1中插入一個 ActiveX 控制項的文字方塊（TextBox1），column J 至column O 存放資料
思路:
1.當在 TextBox1 中按下 Enter 鍵時觸發
2.在 J 欄搜索完全匹配的文字（不區分大小寫）
3.找到後檢查右側 3 格是否在 M 欄範圍內
4.複製範圍包含原格和右側 3 格（共 4 格）
5.判斷 A6 儲存格：
.如果 A6 為空，從 A6 開始貼上
.如果 A6 有資料，則往下找到第一個空白儲存格貼上
6.清除剪貼簿內容，清空 TextBox1 內容。
7.自動將焦點設回 TextBox1，方便連續輸入。
8.用vba寫程式。
#########################ChatGPT####################
Private Sub TextBox1_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
Dim ws As Worksheet
Set ws = Me
Dim searchText As String
searchText = Trim(Me.TextBox1.Text)
If searchText = "" Then Exit Sub
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
Dim i As Long, found As Boolean
For i = 1 To lastRow
If StrComp(ws.Cells(i, "J").Value, searchText, vbTextCompare) = 0 Then
Dim mVal As Variant
mVal = ws.Cells(i, "M").Value
If ws.Cells(i, "K").Value = mVal Or _
ws.Cells(i, "L").Value = mVal Or _
ws.Cells(i, "M").Value = mVal Then
ws.Range(ws.Cells(i, "J"), ws.Cells(i, "M")).Copy
Dim pasteRow As Long
If IsEmpty(ws.Range("A6").Value) Then
pasteRow = 6
Else
pasteRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
End If
ws.Range("A" & pasteRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Me.TextBox1.Text = ""
Me.TextBox1.Activate
found = True
Exit For
End If
End If
Next i
If Not found Then
MsgBox "找不到符合條件的資料", vbExclamation
End If
End If
End Sub
✅【重新產生正確事件程序的方法】
-
在 Excel 中按
Alt + F11打開 VBA 編輯器。 -
在左側點兩下你的工作表名稱（例如
工作表1（vip））。 -
在畫面上方 左邊下拉選單 選擇
TextBox1 -
在 右邊下拉選單 選擇
KeyDown 「完整程式內容」貼到這個 Sub 裡面
✅ 總結
| 問題 | 解決方式 |
|---|---|
| 出現「程序宣告不符合...」錯誤 | 讓 VBA 幫你產生事件程序，不自己手打 |
| 不確定事件名稱和參數 | 使用左上（控制項名稱）與右上（事件名稱）下拉選單產生正確事件框架 |
