返回列表 上一主題 發帖

[發問] 如何經由表單的輸入,在清單找出對應的資料

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 2014-8-20 00:31 | 顯示全部帖子
本帖最後由 luhpro 於 2014-8-20 00:46 編輯
請問各位前輩

小弟已試過許多我懂的方式去寫,仍不能寫出我要的結果,

1.在附檔裡檔案, 共有3個欄位(清 ...
melvinhsu 發表於 2014-8-19 18:16


test-a.zip (12.7 KB)

畫面上物件名稱定義:
item輸入框為  TextBox2, qty 結果顯示區為 Label3,
清單CLEAR按鈕為 CommandButton2, 確認按鈕為 CommandButton1

ActiveSheet 內
  1. Private Sub CommandButton1_Click()
  2.    If Not rTar Is Nothing Then _
  3.         rTar.Resize(1, 3).Interior.ColorIndex = Int(13 * Rnd + 2) * 2
  4. End Sub

  6. Private Sub CommandButton2_Click()
  7.   With Columns("A:C")
  8.     .ClearContents
  9.     .Interior.ColorIndex = -4142
  10.   End With
  11. End Sub

  13. Private Sub TextBox2_Change()
  14.   Dim lRow&
  15.   Dim dItm
  16.   
  17.   Label3 = ""
  18.   lRow = 2
  19.   Do While Cells(lRow, 1) <> ""
  20.    If Cells(lRow, 1) = TextBox2 Then
  21.      Label3 = Cells(lRow, 3)
  22.      Set rTar = Cells(lRow, 1)
  23.      Exit Do
  24.    End If
  25.    lRow = lRow + 1
  26.   Loop
  27.   If Label3 = "" Then MsgBox "找不到資料"
  28. End Sub
複製代碼
Module1 內
  1. Public rTar As Range
複製代碼

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
2#
發表於 2014-8-23 09:25 | 顯示全部帖子
本帖最後由 luhpro 於 2014-8-23 09:52 編輯
小弟再附上檔案 ,
在item欄位 ,如改以 數字 格式的 國際條碼.
1.無法作比對 ,
2.相同在textbox2, ...
melvinhsu 發表於 2014-8-21 09:52

問題1 :
那是因為
Cells(lRow, 1) 內是是數字,
而 TextBox2 內是文字.

即便看到的都是一樣的字,
但兩者的形態不同,
所以 Cells(lRow, 1)  = TextBox2  的資料比對會不成功.
只要在 Cells(lRow, 1) 外加上 CStr () 把它先轉成文字就可以比對成功了.

問題2:
因為  Sub TextBox2_Change 程序實際上是每次內容發生變動(例如輸入 1 個字)就會執行 1 次,
所以 If Label3 = "" Then MsgBox "找不到資料" 這一行訊息會一直出現(造成 scanner  scan資料輸入中斷, 後續資料進不來),
只要拿掉即可.

另, Range 的 Copy 指令使用時,
若只有指定 Destination 而無其他特殊需求,
則 Destination:= 可以不用列出來,
只要打 Cells(2, 8).Copy Cells(3, 8) 即可.

後來我發現 Label3 出現文字(即比對成功)的現象很不明顯,
所以我加上當其內容出現文字時,
底色會變淺綠色,
反之就恢復成白色
這樣比對結果就會明顯多了.

綜上所述程式修改如下:
  1. Private Sub TextBox2_Change()
  2.    Cells(2, 8).Copy Cells(3, 8)
  3.   
  4.   Dim lRow&
  5.   Dim dItm
  6.   
  7.   Label3 = ""
  8.   lRow = 2
  9.   Do While Cells(lRow, 1) <> ""
  10.    If CStr(Cells(lRow, 1)) = TextBox2 Then
  11.      With Label3
  12.        .Caption = Cells(lRow, 3)
  13.        .BackColor = &HC0FFC0
  14.      End With
  15.      Set rTar = Cells(lRow, 1)
  16.      Exit Do
  17.    Else
  18.      Label3.BackColor = &H80000005
  19.    End If
  20.    lRow = lRow + 1
  21.   Loop
  22. End Sub
複製代碼

TOP

        靜思自在 : 話多不如話少，話少不如話好。
返回列表 上一主題