麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 如何經由表單的輸入,在清單找出對應的資料 [打印本頁]

作者: melvinhsu 時間: 2014-8-19 18:16 標題: 如何經由表單的輸入,在清單找出對應的資料

請問各位前輩

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

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

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

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

再麻煩各位了[attach]18963[/attach]

作者: luhpro 時間: 2014-8-20 00:31

本帖最後由 luhpro 於 2014-8-20 00:46 編輯

請問各位前輩

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

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

[attach]18966[/attach]

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

ActiveSheet 內

Private Sub CommandButton1_Click()
If Not rTar Is Nothing Then _
rTar.Resize(1, 3).Interior.ColorIndex = Int(13 * Rnd + 2) * 2
End Sub
Private Sub CommandButton2_Click()
With Columns("A:C")
.ClearContents
.Interior.ColorIndex = -4142
End With
End Sub
Private Sub TextBox2_Change()
Dim lRow&
Dim dItm
Label3 = ""
lRow = 2
Do While Cells(lRow, 1) <> ""
If Cells(lRow, 1) = TextBox2 Then
Label3 = Cells(lRow, 3)
Set rTar = Cells(lRow, 1)
Exit Do
End If
lRow = lRow + 1
Loop
If Label3 = "" Then MsgBox "找不到資料"
End Sub

複製代碼

Module1 內

Public rTar As Range

複製代碼

作者: GBKEE 時間: 2014-8-20 06:45

本帖最後由 GBKEE 於 2014-8-20 07:17 編輯

回復 2# luhpro

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

複製代碼

試試看

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

複製代碼

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

'Sheet1模組的程式碼
Option Explicit
Dim d As Object
Private Sub TextBox1_Change()
Ex
End Sub
Private Sub TextBox2_Change()
Ex
End Sub
Private Sub Ex()
Dim Text(1 To 2) As String
Text(1) = Trim(TextBox1)
Text(2) = Trim(TextBox2) '樓主檔案有用到TextBox2
UsedRange.ClearFormats '取代清單CLEAR按鈕 , CommandButton2
If Text(1) <> "" And Text(2) <> "" Then
If d Is Nothing Then item_qty
If d.EXISTS(Text(1) & Text(2)) Then
d(Text(1) & Text(2)).Interior.ColorIndex = 44
End If
End If
End Sub
Private Sub item_qty()
Dim r As Range
Set d = CreateObject("scripting.dictionary") '字典物件
For Each r In UsedRange.Rows
'item(A攔)&qty(C攔)內容為字典物件key值,指定到 Range
Set d(r.Cells(1, 1) & r.Cells(1, 3)) = r.Cells(1, 1).Resize(, 3)
Next
End Sub

複製代碼

作者: melvinhsu 時間: 2014-8-20 10:20

感謝2 位高手的回覆 ,

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

謝謝

作者: melvinhsu 時間: 2014-8-20 10:51

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

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

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

作者: melvinhsu 時間: 2014-8-21 09:52

小弟再附上檔案 ,

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

1.無法作比對 ,

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

[attach]18986[/attach]

作者: luhpro 時間: 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 出現文字(即比對成功)的現象很不明顯,
所以我加上當其內容出現文字時,
底色會變淺綠色,
反之就恢復成白色
這樣比對結果就會明顯多了.

綜上所述程式修改如下:

Private Sub TextBox2_Change()
Cells(2, 8).Copy Cells(3, 8)
Dim lRow&
Dim dItm
Label3 = ""
lRow = 2
Do While Cells(lRow, 1) <> ""
If CStr(Cells(lRow, 1)) = TextBox2 Then
With Label3
.Caption = Cells(lRow, 3)
.BackColor = &HC0FFC0
End With
Set rTar = Cells(lRow, 1)
Exit Do
Else
Label3.BackColor = &H80000005
End If
lRow = lRow + 1
Loop
End Sub

複製代碼

作者: GBKEE 時間: 2014-8-23 10:38

本帖最後由 GBKEE 於 2014-8-23 10:41 編輯

另, 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 時間: 2014-8-28 10:28

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

再次感謝

作者: melvinhsu 時間: 2014-8-28 11:08

回復 7# luhpro

懂了,,真的感謝

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)