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

melvinhsu

請問各位前輩

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

1.在附檔裡檔案, 共有3個欄位(清單), 而在表單輸入 item訊息 , 則對應清單內找出item 對應的 qty

2.在按下確認時,則該欄位則mark  成任一顏色.

3.按下清除, 則清除清單內所有資料及格式(顏色)


再麻煩各位了 test.rar (12.96 KB)

下載次數: 6

2014-8-19 18:16

luhpro

請問各位前輩

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

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

test-a.zip (12.7 KB)

下載次數: 6

2014-8-20 00:46

畫面上物件名稱定義:
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
   
5. 
   
6. Private Sub CommandButton2_Click()
   
7.   With Columns("A:C")
   
8.     .ClearContents
   
9.     .Interior.ColorIndex = -4142
   
10.   End With
    
11. End Sub
    
12. 
    
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

複製代碼

GBKEE

回復 2# luhpro

1. Private Sub CommandButton2_Click()
   
2.         With Columns("A:C")
   
3.             .ClearContents
   
4.             'ClearContents 方法 清除範圍的公式。清除圖表中的資料但保留格式設定。
   
5.             '****清除範圍的公式也包含清除範圍的字串***

複製代碼

試試看

1. 'Sheet1模組的程式碼
   
2. Option Explicit
   
3. Dim d As Object
   
4. Private Sub CommandButton1_Click()
   
5.     Dim Text(1 To 2) As String
   
6.     Text(1) = Trim(TextBox1)
   
7.     Text(2) = Trim(TextBox2)  '樓主檔案有用到TextBox2
   
8.     UsedRange.ClearFormats    '取代  清單CLEAR按鈕 , CommandButton2
   
9.     If Text(1) <> "" And Text(2) <> "" Then
   
10.         If d Is Nothing Then item_qty
    
11.         If d.EXISTS(Text(1) & Text(2)) Then
    
12.             d(Text(1) & Text(2)).Interior.ColorIndex = 44
    
13.         End If
    
14.     End If
    
15. End Sub
    
16. Private Sub item_qty()
    
17.     Dim r As Range
    
18.     Set d = CreateObject("scripting.dictionary") '字典物件
    
19.     For Each r In UsedRange.Rows
    
20.         'item(A攔)&qty(C攔)內容為字典物件key值,指定到 Range
    
21.         Set d(r.Cells(1, 1) & r.Cells(1, 3)) = r.Cells(1, 1).Resize(, 3)        
    
22.     Next
    
23. End Sub

複製代碼

不用使用 CommandButton1,
TextBox1,TextBox2 有改變直接顯示

1. 'Sheet1模組的程式碼
   
2. Option Explicit
   
3. Dim d As Object
   
4. Private Sub TextBox1_Change()
   
5.     Ex
   
6. End Sub
   
7. 
   
8. Private Sub TextBox2_Change()
   
9.     Ex
   
10. End Sub
    
11. Private Sub Ex()
    
12.     Dim Text(1 To 2) As String
    
13.     Text(1) = Trim(TextBox1)
    
14.     Text(2) = Trim(TextBox2)  '樓主檔案有用到TextBox2
    
15.     UsedRange.ClearFormats    '取代  清單CLEAR按鈕 , CommandButton2
    
16.     If Text(1) <> "" And Text(2) <> "" Then
    
17.         If d Is Nothing Then item_qty
    
18.         If d.EXISTS(Text(1) & Text(2)) Then
    
19.             d(Text(1) & Text(2)).Interior.ColorIndex = 44
    
20.         End If
    
21.     End If
    
22. End Sub
    
23. Private Sub item_qty()
    
24.     Dim r As Range
    
25.     Set d = CreateObject("scripting.dictionary") '字典物件
    
26.     For Each r In UsedRange.Rows
    
27.         'item(A攔)&qty(C攔)內容為字典物件key值,指定到 Range
    
28.         Set d(r.Cells(1, 1) & r.Cells(1, 3)) = r.Cells(1, 1).Resize(, 3)
    
29.         
    
30.     Next
    
31. End Sub

複製代碼

melvinhsu

感謝2 位高手的回覆 ,

這再請教_  
1.在textbox2 , 輸入比對的資料只能為 英文 ,數字不能作輸入 . 原因是如何呢


謝謝

melvinhsu

小弟, 若 將清單的 item欄位 ,改以14-16 碼 的數字 , 在textbox2無法作比對

2.相同在textbox2,用scanner  scan資料進入, 只有出現頭前的1碼 .

這原因是如何呢.  謝謝 ,再麻煩各位

melvinhsu

小弟再附上檔案 ,

在item欄位 ,如改以 數字 格式的 國際條碼.

1.無法作比對 ,

2.相同在textbox2,以scan 方式只有頭1碼

test-2.rar (16.92 KB)

下載次數: 10

2014-8-21 09:52

luhpro

小弟再附上檔案 ,
在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

複製代碼

GBKEE

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

是可不指明第一個參數的名稱

expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
不指明需   , , , expression.Find( "TEST", , , , , , ,  ,  TRUE)
指明可省略 , , , expression.Find( "TEST",  SearchFormat:=True)

melvinhsu

謝謝2 位的指導, 及 協助, 又學到了 一課,

再次感謝

melvinhsu

回復 7# luhpro


    懂了,,真的感謝