我有一個 EXCEL 檔。
工作表1名稱為 Print_Order，工作表2名稱為 DataBase。
工作表2(DataBase)中 column A 至column F 存放資料。
在工作表1(Print_Order)中插入一個 ActiveX 控制項的文字方塊（TextBox1）。
1.當在工作表1(Print_Order)中的 TextBox1 中按下 Enter 鍵時觸發
2.在工作表2(DataBase)的A 欄搜索完全匹配的文字（不區分大小寫），A 欄有重複資料。
3.找到後檢查右側 5 格是否在 F 欄範圍內
4.複製範圍包含原格和右側 5 格（共 6 格）
5.判斷在工作表1(Print_Order)的 A6 儲存格：
.如果 A6 為空，從 A6 開始貼上
.如果 A6 有資料，則往下找到第一個空白儲存格貼上
6.重複 步驟2至步驟5，搜尋下一個相同資料
7.清除剪貼簿內容，清空 TextBox1 內容。
8.自動將焦點設回 TextBox1，方便連續輸入。
9.用vba寫程式。
=========================================
| 功能 | 說明 |
|---|---|
| 🔍 搜尋 | 在 DataBase 工作表的 A 欄尋找完全匹配的文字（不區分大小寫），A 欄可有重複值 |
| ✅ 條件 | 找到資料後，檢查該列的 B~F 欄是否有任一格等於該列的 F 欄值 |
| 📋 複製 | 複製 A~F 六欄資料 |
| 📌 貼上 | 貼到 Print_Order 工作表的 A6 開始，若已有資料則往下找第一個空列貼上 |
| ♻️ 重複 | 所有匹配項都執行相同邏輯 |
| 🧼 清理 | 執行後清空 TextBox1 並將焦點設回 |
Private Sub TextBox1_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
Dim wsPrint As Worksheet
Dim wsData As Worksheet
Set wsPrint = ThisWorkbook.Sheets("Print_Order")
Set wsData = ThisWorkbook.Sheets("DataBase")
Dim searchText As String
searchText = Trim(Me.TextBox1.Text)
If searchText = "" Then Exit Sub
Dim lastRow As Long
lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
Dim i As Long
Dim pasteRow As Long
Dim firstPaste As Boolean
firstPaste = True
For i = 1 To lastRow
If StrComp(wsData.Cells(i, "A").Value, searchText, vbTextCompare) = 0 Then
Dim fVal As Variant
fVal = wsData.Cells(i, "F").Value
' 檢查 B~F 中是否有與 F 相等的值
If wsData.Cells(i, "B").Value = fVal Or _
wsData.Cells(i, "C").Value = fVal Or _
wsData.Cells(i, "D").Value = fVal Or _
wsData.Cells(i, "E").Value = fVal Or _
wsData.Cells(i, "F").Value = fVal Then
' 複製 A~F
wsData.Range(wsData.Cells(i, "A"), wsData.Cells(i, "F")).Copy
' 找貼上位置
If firstPaste Then
If IsEmpty(wsPrint.Range("A6").Value) Then
pasteRow = 6
Else
pasteRow = wsPrint.Cells(wsPrint.Rows.Count, "A").End(xlUp).Row + 1
End If
firstPaste = False
Else
pasteRow = wsPrint.Cells(wsPrint.Rows.Count, "A").End(xlUp).Row + 1
End If
' 貼上值
wsPrint.Range("A" & pasteRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End If
Next i
' 清除輸入與焦點重設
Me.TextBox1.Text = ""
Me.TextBox1.Activate
End If
End Sub
