返回列表 上一主題 發帖

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

melvinhsu

帖子
14 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
WINDOWS 
軟體版本
VISTA 
閱讀權限
10 
註冊時間
2010-9-10 
最後登錄
2015-1-6 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-8-19 18:16 | 只看該作者

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

請問各位前輩

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

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

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

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


再麻煩各位了 test.rar (12.96 KB)
收藏 分享

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2014-8-20 06:45 | 只看該作者
本帖最後由 GBKEE 於 2014-8-20 07:17 編輯

回復 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

  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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

melvinhsu

帖子
14 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
WINDOWS 
軟體版本
VISTA 
閱讀權限
10 
註冊時間
2010-9-10 
最後登錄
2015-1-6 

論壇贊助勳章
4#
發表於 2014-8-20 10:20 | 只看該作者
感謝2 位高手的回覆 ,

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


謝謝

TOP

melvinhsu

帖子
14 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
WINDOWS 
軟體版本
VISTA 
閱讀權限
10 
註冊時間
2010-9-10 
最後登錄
2015-1-6 

論壇贊助勳章
5#
發表於 2014-8-20 10:51 | 只看該作者
小弟, 若 將清單的 item欄位 ,改以14-16 碼 的數字 , 在textbox2無法作比對

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

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

TOP

melvinhsu

帖子
14 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
WINDOWS 
軟體版本
VISTA 
閱讀權限
10 
註冊時間
2010-9-10 
最後登錄
2015-1-6 

論壇贊助勳章
6#
發表於 2014-8-21 09:52 | 只看該作者
小弟再附上檔案 ,

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

1.無法作比對 ,

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

test-2.rar (16.92 KB)

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
7#
發表於 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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 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)
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

melvinhsu

帖子
14 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
WINDOWS 
軟體版本
VISTA 
閱讀權限
10 
註冊時間
2010-9-10 
最後登錄
2015-1-6 

論壇贊助勳章
9#
發表於 2014-8-28 10:28 | 只看該作者
謝謝2 位的指導, 及 協助, 又學到了 一課,

再次感謝

TOP

melvinhsu

帖子
14 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
WINDOWS 
軟體版本
VISTA 
閱讀權限
10 
註冊時間
2010-9-10 
最後登錄
2015-1-6 

論壇贊助勳章
10#
發表於 2014-8-28 11:08 | 只看該作者
回復 7# luhpro


    懂了,,真的感謝

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題