2025年5月17日 星期六

Print_Order 2 (chat_GPT版)

 我有一個 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








Print_Order (chat_GPT版)

我有一個 EXCEL 工作表1,工作表1名稱為 Print_Order

工作表1中插入一個 ActiveX 控制項的文字方塊(TextBox1)。工作表1中 column A 至column F 存放資料。



1.當在工作表1中的 TextBox1 中按下 Enter 鍵時觸發

2.在 A 欄搜索完全匹配的文字(不區分大小寫),A 欄有重複資料。

3.找到後檢查右側 5 格是否在 F 欄範圍內

4.複製範圍包含原格和右側 5 格(共 6 格)

5.判斷在工作表1的 H4 儲存格:

.如果 H4 為空,從 H4 開始貼上

.如果 H4 有資料,則往下找到第一個空白儲存格貼上

6.重複 步驟2至步驟5,搜尋下一個相同資料

6.清除剪貼簿內容,清空 TextBox1 內容。

7.自動將焦點設回 TextBox1,方便連續輸入。

8.用vba寫程式。

=============================================================

✅【重新產生正確事件程序的方法】

  1. 在 Excel 中按 Alt + F11 打開 VBA 編輯器。

  2. 在左側點兩下你的工作表名稱(例如 工作表1(Print_out))。

  3. 在畫面上方 左邊下拉選單 選擇 TextBox1。

  4. 右邊下拉選單 選擇 KeyDown 。

  5. 貼上程式碼。

=============================================================

Private Sub TextBox1_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)

    If KeyCode = vbKeyReturn Then

        Dim ws As Worksheet

        Set ws = Me ' 指的是 Print_Order


        Dim searchText As String

        searchText = Trim(Me.TextBox1.Text)

        If searchText = "" Then Exit Sub


        Dim lastRow As Long

        lastRow = ws.Cells(ws.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(ws.Cells(i, "A").Value, searchText, vbTextCompare) = 0 Then

                Dim fVal As Variant

                fVal = ws.Cells(i, "F").Value


                ' 檢查右邊5格是否有一格等於F欄的值

                If ws.Cells(i, "B").Value = fVal Or _

                   ws.Cells(i, "C").Value = fVal Or _

                   ws.Cells(i, "D").Value = fVal Or _

                   ws.Cells(i, "E").Value = fVal Or _

                   ws.Cells(i, "F").Value = fVal Then


                    ' 複製 A 至 F 共6格

                    ws.Range(ws.Cells(i, "A"), ws.Cells(i, "F")).Copy


                    ' 找貼上位置

                    If firstPaste Then

                        If IsEmpty(ws.Range("H4").Value) Then

                            pasteRow = 4

                        Else

                            pasteRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row + 1

                        End If

                        firstPaste = False

                    Else

                        pasteRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row + 1

                    End If


                    ws.Range("H" & pasteRow).PasteSpecial Paste:=xlPasteValues

                    Application.CutCopyMode = False

                End If

            End If

        Next i


        ' 清除 TextBox 與焦點回復

        Me.TextBox1.Text = ""

        Me.TextBox1.Activate

    End If

End Sub

=============================================================



插入 BarCode 控制項: (如果尚未插入)

  • 切換到 開發人員 索引標籤。
  • 在「控制項」群組中,按一下 插入,然後在「ActiveX 控制項」下方選擇 Microsoft BarCode Control 16.0 (或類似名稱)。
  • 在工作表 1 中拖曳滑鼠,繪製出您想要放置條碼的區域。
  • 將這個 BarCode 控制項的 (Name) 屬性在「屬性」視窗中更改為一個容易識別的名稱,例如 BarcodeCtrl
   LinkedCell 設定為 H6 





選 Code-128 才會顯示出來


LinkedCell 設定為 H6 時,可以看到預覽條碼 (Sample Barcode),但在 H6 輸入數字後條碼卻變為空白,這表示 BarCode 控制項本身是正常運作的,問題可能出在資料傳輸或格式上。


列印按鈕
Sub Print_out()
'
' Print_out 巨集
'

'
    Range("H2:N23").Select
    Selection.PrintOut Copies:=1, Collate:=True
End Sub


清空資料按鈕
Sub Clear_OrderData()
'
' Clear_OrderData 巨集
'

'
    Range("H6:M22").Select
    Selection.ClearContents
    Range("H6").Select
End Sub


列印完接著清空資料,方便連續輸入再列印。


當在 TextBox1 中按下 Enter 鍵時觸發在 J 欄搜索完全匹配的文字 (Gemini版)

 我有一個 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




程式碼說明:

  1. Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): 這個是 TextBox1 的 KeyDown 事件處理程序。當在 TextBox1 中按下按鍵時,這個程式碼會被觸發。
  2. If KeyCode = 13 Then: 檢查按下的按鍵是否是 Enter 鍵(KeyCode 13)。
  3. Dim 宣告: 宣告程式中使用的變數,例如工作表物件、儲存格範圍等。
  4. Set ws1 = ThisWorkbook.Sheets("vip"): 設定 ws1 變數指向名為 "vip" 的工作表。
  5. Set ws2 = ThisWorkbook.Sheets("工作表2"): 請注意: 這行程式碼假設您要將資料貼到名為 "工作表2" 的工作表中。如果您要貼到其他工作表,請將 "工作表2" 替換為實際的工作表名稱。
  6. Set searchRange = ws1.Columns("J"): 設定在 "vip" 工作表的 J 欄中進行搜尋。
  7. Set foundCell = searchRange.Find(...): 使用 Find 方法在 searchRange 中尋找與 TextBox1 中的文字完全匹配的儲存格。
    • What:=TextBox1.Text: 指定要尋找的文字是 TextBox1 的內容。
    • LookIn:=xlValues: 在儲存格的值中搜尋。
    • LookAt:=xlWhole: 尋找完全匹配的儲存格內容。
    • MatchCase:=False: 不區分大小寫。
  8. If Not foundCell Is Nothing Then: 檢查是否找到了匹配的儲存格。如果 foundCell 不是 Nothing,表示找到了。
  9. If foundCell.Column <= 10 And foundCell.Column + 3 <= 13 Then: 檢查找到的儲存格是否在 J 欄(第 10 欄)或更靠左,並且其右側的 3 個儲存格是否在 M 欄(第 13 欄)範圍內。
  10. Set copyRange = ws1.Range(foundCell, foundCell.Offset(0, 3)): 設定要複製的範圍,從找到的儲存格開始,向右偏移 0 列、3 欄。
  11. If IsEmpty(ws2.Range("A6").Value) Then ... Else ... End If: 判斷目標工作表的 A6 儲存格是否為空,並設定 pasteCell 為要貼上的目標儲存格。
  12. lastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row: 如果 A6 有資料,這行程式碼會找到目標工作表 A 欄中最後一個有資料的儲存格的列號。
  13. Set pasteCell = ws2.Cells(lastRow + 1, "A"): 將 pasteCell 設定為 A 欄中第一個空白的儲存格。
  14. copyRange.Copy: 複製選定的範圍。
  15. pasteCell.PasteSpecial Paste:=xlPasteValues: 將複製的內容以值的形式貼到目標儲存格。您可以根據需要更改 Paste 參數,例如 xlPasteFormats(貼上格式)、xlPasteAll(貼上所有)等。
  16. Application.CutCopyMode = False: 清除剪貼簿的複製模式。
  17. TextBox1.Text = "": 清空 TextBox1 的內容。
  18. TextBox1.Activate: 將焦點設定回 TextBox1。
  19. Else: 如果 Find 方法沒有找到匹配的儲存格,則顯示一個訊息框。

使用方法:

  1. 確保您的工作表 1 名稱為 "vip"。
  2. 在 "vip" 工作表中插入一個 ActiveX 控制項的文字方塊,並將其名稱設定為 "TextBox1"(預設名稱通常就是 TextBox1,但最好檢查一下)。
  3. 將上述 VBA 程式碼貼到 "vip" 工作表的程式碼視窗中。
  4. 請務必將程式碼中的 Set ws2 = ThisWorkbook.Sheets("工作表2") 這一行中的 "工作表2" 替換為您希望將資料貼上的實際工作表名稱。
  5. 關閉 VBA 編輯器。
  6. 返回您的 Excel 工作表 "vip"。
  7. 在 TextBox1 中輸入您想要搜尋的文字(不區分大小寫)。
  8. 按下 Enter 鍵。程式碼將會在 J 欄中尋找匹配的文字,如果找到且右側有足夠的資料,它將會複製包含匹配儲存格和其右側 3 個儲存格的範圍,並將其貼到您指定的工作表的 A 欄中,從 A6 開始或下一個空白儲存格。之後,TextBox1 會被清空,並且焦點會自動回到 TextBox1,方便您進行下一次輸入。

當在 TextBox1 中按下 Enter 鍵時觸發在 J 欄搜索完全匹配的文字 (ChatGPT版)

我有一個 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





✅【重新產生正確事件程序的方法】

  1. 在 Excel 中按 Alt + F11 打開 VBA 編輯器。

  2. 在左側點兩下你的工作表名稱(例如 工作表1(vip))。

  3. 在畫面上方 左邊下拉選單 選擇 TextBox1

  4. 右邊下拉選單 選擇 KeyDown

  5. 「完整程式內容」貼到這個 Sub 裡面


✅ 總結

問題解決方式
出現「程序宣告不符合...」錯誤讓 VBA 幫你產生事件程序,不自己手打
不確定事件名稱和參數使用左上(控制項名稱)與右上(事件名稱)下拉選單產生正確事件框架