我有一個 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寫程式。
######################### Gemini ####################
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then ' 13 是 Enter 鍵的 KeyCode
Dim ws1 As Worksheet
Dim ws2 As Worksheet ' 假設您要貼上的目標工作表是工作表2，如果不是請更改
Dim lastRow As Long
Dim searchRange As Range
Dim foundCell As Range
Dim copyRange As Range
Dim pasteCell As Range
' 設定工作表物件
Set ws1 = ThisWorkbook.Sheets("vip")
' 假設您要貼上的目標工作表是工作表2，如果不是請更改工作表名稱
Set ws2 = ThisWorkbook.Sheets("工作表2")
' 設定在 J 欄的搜尋範圍
Set searchRange = ws1.Columns("J")
' 使用 Find 方法尋找完全匹配的文字（不區分大小寫）
Set foundCell = searchRange.Find(What:=TextBox1.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
' 檢查是否找到匹配的儲存格
If Not foundCell Is Nothing Then
' 檢查右側 3 格是否在 M 欄範圍內
If foundCell.Column <= 10 And foundCell.Column + 3 <= 13 Then ' J 欄是第 10 欄，M 欄是第 13 欄
' 設定要複製的範圍（原格和右側 3 格）
Set copyRange = ws1.Range(foundCell, foundCell.Offset(0, 3))
' 判斷 A6 儲存格
If IsEmpty(ws2.Range("A6").Value) Then
' A6 為空，從 A6 開始貼上
Set pasteCell = ws2.Range("A6")
Else
' A6 有資料，往下找到第一個空白儲存格
lastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
Set pasteCell = ws2.Cells(lastRow + 1, "A")
End If
' 複製並貼上範圍
copyRange.Copy
pasteCell.PasteSpecial Paste:=xlPasteValues ' 僅貼上值，您可以根據需要更改
' 清除剪貼簿內容
Application.CutCopyMode = False
' 清空 TextBox1 內容
TextBox1.Text = ""
' 自動將焦點設回 TextBox1
TextBox1.Activate
Else
MsgBox "找到匹配項，但右側的資料超出 M 欄範圍。", vbExclamation
End If
Else
MsgBox "找不到匹配的文字。", vbExclamation
End If
End If
End Sub
程式碼說明：
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): 這個是 TextBox1 的KeyDown事件處理程序。當在 TextBox1 中按下按鍵時，這個程式碼會被觸發。If KeyCode = 13 Then: 檢查按下的按鍵是否是 Enter 鍵（KeyCode 13）。Dim宣告: 宣告程式中使用的變數，例如工作表物件、儲存格範圍等。Set ws1 = ThisWorkbook.Sheets("vip"): 設定ws1變數指向名為 "vip" 的工作表。Set ws2 = ThisWorkbook.Sheets("工作表2"): 請注意： 這行程式碼假設您要將資料貼到名為 "工作表2" 的工作表中。如果您要貼到其他工作表，請將"工作表2"替換為實際的工作表名稱。Set searchRange = ws1.Columns("J"): 設定在 "vip" 工作表的 J 欄中進行搜尋。Set foundCell = searchRange.Find(...): 使用Find方法在searchRange中尋找與 TextBox1 中的文字完全匹配的儲存格。What:=TextBox1.Text: 指定要尋找的文字是 TextBox1 的內容。LookIn:=xlValues: 在儲存格的值中搜尋。LookAt:=xlWhole: 尋找完全匹配的儲存格內容。MatchCase:=False: 不區分大小寫。
If Not foundCell Is Nothing Then: 檢查是否找到了匹配的儲存格。如果foundCell不是Nothing，表示找到了。If foundCell.Column <= 10 And foundCell.Column + 3 <= 13 Then: 檢查找到的儲存格是否在 J 欄（第 10 欄）或更靠左，並且其右側的 3 個儲存格是否在 M 欄（第 13 欄）範圍內。Set copyRange = ws1.Range(foundCell, foundCell.Offset(0, 3)): 設定要複製的範圍，從找到的儲存格開始，向右偏移 0 列、3 欄。If IsEmpty(ws2.Range("A6").Value) Then ... Else ... End If: 判斷目標工作表的 A6 儲存格是否為空，並設定pasteCell為要貼上的目標儲存格。lastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row: 如果 A6 有資料，這行程式碼會找到目標工作表 A 欄中最後一個有資料的儲存格的列號。Set pasteCell = ws2.Cells(lastRow + 1, "A"): 將pasteCell設定為 A 欄中第一個空白的儲存格。copyRange.Copy: 複製選定的範圍。pasteCell.PasteSpecial Paste:=xlPasteValues: 將複製的內容以值的形式貼到目標儲存格。您可以根據需要更改Paste參數，例如xlPasteFormats（貼上格式）、xlPasteAll（貼上所有）等。Application.CutCopyMode = False: 清除剪貼簿的複製模式。TextBox1.Text = "": 清空 TextBox1 的內容。TextBox1.Activate: 將焦點設定回 TextBox1。Else: 如果Find方法沒有找到匹配的儲存格，則顯示一個訊息框。
使用方法：
- 確保您的工作表 1 名稱為 "vip"。
- 在 "vip" 工作表中插入一個 ActiveX 控制項的文字方塊，並將其名稱設定為 "TextBox1"（預設名稱通常就是 TextBox1，但最好檢查一下）。
- 將上述 VBA 程式碼貼到 "vip" 工作表的程式碼視窗中。
- 請務必將程式碼中的
Set ws2 = ThisWorkbook.Sheets("工作表2")這一行中的"工作表2"替換為您希望將資料貼上的實際工作表名稱。 - 關閉 VBA 編輯器。
- 返回您的 Excel 工作表 "vip"。
- 在 TextBox1 中輸入您想要搜尋的文字（不區分大小寫）。
- 按下 Enter 鍵。程式碼將會在 J 欄中尋找匹配的文字，如果找到且右側有足夠的資料，它將會複製包含匹配儲存格和其右側 3 個儲存格的範圍，並將其貼到您指定的工作表的 A 欄中，從 A6 開始或下一個空白儲存格。之後，TextBox1 會被清空，並且焦點會自動回到 TextBox1，方便您進行下一次輸入。
