Board logo

標題: [發問] 可自定表單 全文檢索? [打印本頁]
作者: user999    時間: 2011-12-6 16:33     標題: 可自定表單 全文檢索?

可自定表單 全文檢索某一攔位的資料?
請教各位專家,謝謝!
作者: register313    時間: 2011-12-6 17:44

回復 1# user999

   初學VBA
   用基本語法拼湊
  尚有許多缺點未解決
  本帖回復至此(因功力不夠)
作者: GBKEE    時間: 2011-12-7 18:28

回復 2# register313
可如此


[attach]8755[/attach]
作者: user999    時間: 2011-12-9 18:12

感謝GBKEE大大指導
那再近一步請問 文內有大小寫
輸入也有大小寫
如何不分大小寫一起搜尋
謝謝!
作者: HUNGCHILIN    時間: 2011-12-10 15:22

本帖最後由 HUNGCHILIN 於 2011-12-10 15:43 編輯

GB兄寫的真棒
user999 題目也問的很好

這題以前沒練習過，是個不錯的範例，謝謝分享
作者: GBKEE    時間: 2011-12-10 16:47

回復 5# user999
使用  Option Compare 陳述式  在模組層次中用來宣告當比較字串資料的比對方式.
請在表單模組頂端 加上 Option Compare Text    可以不分大小寫來比對
作者: user999    時間: 2011-12-11 22:54

回復 7# GBKEE


    多謝幫忙
作者: dafa    時間: 2012-1-5 10:45

回復 7# GBKEE


    請問G大
   如果資料有2欄以上
   要如何做
作者: GBKEE    時間: 2012-1-5 11:29

回復 10# dafa
2欄什麼? 請上傳範例
作者: dafa    時間: 2012-1-5 11:55

回復 11# GBKEE


   很抱歉說的不清不楚
如本文範例資料都在A欄
如果資料有B欄或C欄...以上該如何做
因為在公司不方便上傳資料...請見諒
作者: GBKEE    時間: 2012-1-5 14:52

回復 12# dafa
你不做個範例上傳,真的不知要如何回答.
作者: dafa    時間: 2012-1-5 15:28

[attach]9080[/attach]回復 13# GBKEE


    如附件
請問G大
可否連同B.C.D欄內資料一同顯示在ListBox1與Label2內
感謝你
作者: GBKEE    時間: 2012-1-5 16:12

回復 14# dafa
  1. Private Sub UserForm_Initialize()
  2.      With ListBox1
  3.         .Visible = False
  4.         .ColumnCount = 4                '指定下拉式清單方塊或清單方塊的顯示行數。
  5.         .ColumnWidths = "370,40,40,40"  '指定多行下拉式清單方塊或清單方塊中的各行寬度。
  6.     End With
  7. End Sub
  8. Private Sub ListBox1_Change()
  9.     AA = Application.Index(ListBox1.List, ListBox1.ListIndex + 1)  '陣列中抽出指定的元素陣列(這裡是一維陣列)
  10.     Label2.Caption = "[" & Join(AA, "] ; [") & "]"                  'Join 結合一維陣列的文字
  11. End Sub
  12. Private Sub TextBox1_Change()
  13.     Dim Ar(), E As Range
  14.     If TextBox1 <> "" Then
  15.         ReDim Ar(0)
  16.         For Each E In Sheet1.UsedRange.Columns(1).Cells
  17.             If E Like "*" & TextBox1 & "*" Then
  18.                 Ar(UBound(Ar)) = E.Resize(, 4).Value
  19.                 ReDim Preserve Ar(UBound(Ar) + 1)
  20.             End If
  21.         Next
  22.         If UBound(Ar) > 0 Then
  23.             ReDim Preserve Ar(UBound(Ar) - 1)
  24.             Ar = Application.Transpose(Application.Transpose(Ar))
  25.             ListBox1.List = Ar
  26.             ListBox1.Visible = True
  27.         Else
  28.             Label2.Caption = ""
  29.             ListBox1.Visible = False
  30.         End If
  31.     Else
  32.         Label2.Caption = ""
  33.         ListBox1.Visible = False
  34.     End If
  35. End Sub
複製代碼
作者: dafa    時間: 2012-1-5 16:37

回復 15# GBKEE


    很感謝G大那麼不厭其煩的回覆
還附註那麼清楚
趕快去研究消化一下
感恩喔
作者: dafa    時間: 2012-5-29 10:04

回復 15# GBKEE
  1. Private Sub UserForm_Initialize()
  2.      With ListBox1
  3.         .Visible = False
  4.         .ColumnCount = 4                '指定下拉式清單方塊或清單方塊的顯示行數。
  5.         .ColumnWidths = "370,40,40,40"  '指定多行下拉式清單方塊或清單方塊中的各行寬度。
  6.     End With
  7. End Sub
  8. Private Sub ListBox1_Change()
  9.     AA = Application.Index(ListBox1.List, ListBox1.ListIndex + 1)  '陣列中抽出指定的元素陣列(這裡是一維陣列)
  10.     Label2.Caption = "[" & Join(AA, "] ; [") & "]"                  'Join 結合一維陣列的文字
  11. End Sub
  12. Private Sub TextBox1_Change()
  13.     Dim Ar(), E As Range
  14.     If TextBox1 <> "" Then
  15.         ReDim Ar(0)
  16.         For Each E In Sheet1.UsedRange.Columns(1).Cells
  17.             If E Like "*" & TextBox1 & "*" Then
  18.                 Ar(UBound(Ar)) = E.Resize(, 4).Value
  19.                 ReDim Preserve Ar(UBound(Ar) + 1)
  20.             End If
  21.         Next
  22.         If UBound(Ar) > 0 Then
  23.             ReDim Preserve Ar(UBound(Ar) - 1)
  24.             Ar = Application.Transpose(Application.Transpose(Ar))   '可以麻煩G大幫我解釋這句為何要轉置再轉置   感謝      
  25.    ListBox1.List = Ar
  26.             ListBox1.Visible = True
  27.         Else
  28.             Label2.Caption = ""
  29.             ListBox1.Visible = False
  30.         End If
  31.     Else
  32.         Label2.Caption = ""
  33.         ListBox1.Visible = False
  34.     End If
  35. End Sub
複製代碼
作者: GBKEE    時間: 2012-5-29 17:27

回復 17# dafa
  1. If E Like "*" & TextBox1 & "*" Then     
  2.                 Ar(UBound(Ar)) = E.Resize(, 4).Value  '***一維陣列Ar 加入子元素 -> E.Resize(, 4).Value  ※此子元素 是為( 1, 4 )二維陣列                 ReDim Preserve Ar(UBound(Ar) + 1)
複製代碼
  1. If UBound(Ar) > 0 Then
  2.             ReDim Preserve Ar(UBound(Ar) - 1)
  3.             'Ar = Application.Transpose(Application.Transpose(Ar))
  4.             Ar = Application.Transpose(Ar) '第一次轉置  得到的是 整欄資料
  5.             Ar = Application.Transpose(Ar) '第二次轉置 得到的是  整列資料   
複製代碼
作者: dafa    時間: 2012-5-30 16:02

回復 18# GBKEE


    感謝G大的解釋
如本範例
在請問G大如果我ListBox1屬性設定可複選
但我要如何將ListBox1所有挑選的資料放到Label2呢
作者: dechiuan999    時間: 2012-5-31 19:23

版主大大您好：

請問如何能讓全文檢索表單的
Listbox也能具有左右捲動功能呢？

感謝您！
作者: dafa    時間: 2012-6-1 10:18

回復 20# dechiuan999


    只要你的 ListBox屬性Width<ColumnWidths就應該會自己出現了
作者: dechiuan999    時間: 2012-6-1 13:11

dafa 大大您好：

謝謝您的說明。
感恩！
作者: GBKEE    時間: 2012-6-1 14:25

回復 19# dafa
  1. Private Sub UserForm_Initialize()
  2.      With ListBox1
  3.         .MultiSelect = fmMultiSelectMulti   '=> 1  :  ListBox1屬性設定可複選
  4.        ' fmMultiSelectSingle 0 只能選取一個專案 ( 預設 )。
  5.        ' fmMultiSelectSimple 1 按下空白鍵或按下滑鼠鍵，可以選取、取消選取清單中的專案。
  6.        '  fmMultiSelectExtended 2 按下 SHIFT 並按下滑鼠鍵，或按下 SHIFT 並按下一個方向鍵，可選取一個範圍內的所有專案。按下 CTRL 並按下滑鼠鍵，可選取或取消選取一個專案。

  8.         .Visible = False
  9.         .ColumnCount = 4                '指定下拉式清單方塊或清單方塊的顯示行數。
  10.         .ColumnWidths = "370,40,40,40"  '指定多行下拉式清單方塊或清單方塊中的各行寬度。
  11.     End With
  12. End Sub
  13. Private Sub ListBox1_Change()
  14.     Dim xlString  As String, AA(), xi As Integer
  15.     With ListBox1
  16.         For xi = 0 To .ListCount - 1
  17.             If .Selected(xi) = True Then
  18.                 AA = Application.Index(ListBox1.List, ListBox1.ListIndex + 1)  '陣列中抽出指定的元素陣列(這裡是一維陣列)
  19.                 xlString = IIf(xlString = "", "[" & Join(AA, "] ; [") & "]", xlString & Chr(10) & "[" & Join(AA, "] ; [") & "]")
  20.             End If
  21.         Next
  22.     End With
  23.     Label2.Caption = xlString
  24. End Sub
複製代碼
作者: dafa    時間: 2012-6-1 15:10

回復 23# GBKEE


    很感謝G大的協助解答
G大的功力真是博大精深
趕快來去消化一下
作者: dafa    時間: 2012-6-1 16:09

回復 23# GBKEE


   請問G大
我剛剛試了一下結果挑選第2筆資料時
Label2.Caption的第一筆資料與第二筆資料都變成同一筆資料了
作者: GBKEE    時間: 2012-6-1 16:29

回復 25# dafa
抱歉了
  1. Private Sub ListBox1_Change()
  2.     Dim xlString  As String, AA(), xi As Integer
  3.     With ListBox1
  4.         For xi = 0 To .ListCount - 1
  5.             If .Selected(xi) = True Then
  6.                 AA = Application.Index(ListBox1.List, xi + 1)   '***這裡沒修改    陣列中抽出指定的元素陣列(這裡是一維陣列)
  7.                 xlString = IIf(xlString = "", "[" & Join(AA, "] ; [") & "]", xlString & Chr(10) & "[" & Join(AA, "] ; [") & "]")
  8.             End If
  9.         Next
  10.     End With
  11.     Label2.Caption = xlString
  12. End Sub
複製代碼
作者: dechiuan999    時間: 2012-6-2 08:37

[attach]11225[/attach]各位大大好：

  版主大大提供的全文檢索
功能實在太好用了。
  但是小弟有一問題一直無法
突破，想請各位大大幫小弟如何
克服此項問題。
  小弟是直接由MDB資料庫取出
大批資料，但是在TEXTBOX1內
輸入資料時，會出現

執行階段錯誤13
型態不符合
Private Sub TextBox1_Change()

    Dim Ar()
    Dim E As Range
    Dim mSht1 As Worksheet
   
    Set mSht1 = Worksheets("TEST")   
    If TextBox1 <> "" Then
        ReDim Ar(0)
        'For Each E In mSht1.UsedRange.Columns(1).Cells
        For Each E In mSht1.Range("a1", mSht1.Range("a1:d900")).Columns(1).Cells     '測試到 800 的位置是 OK
            If E Like "*" & TextBox1 & "*" Then
                Ar(UBound(Ar)) = E.Resize(, 4).Value
                ReDim Preserve Ar(UBound(Ar) + 1)
            End If
        Next
   
        If UBound(Ar) > 0 Then
            ReDim Preserve Ar(UBound(Ar) - 1)
            Ar = Application.Transpose(Application.Transpose(Ar))     '執行階段錯誤：13 型態不符合
            ListBox1.List = Ar
            ListBox1.Visible = True
        Else
            Label1.Caption = ""
            ListBox1.Visible = False
        End If
    Else
        Label1.Caption = ""
        ListBox1.Visible = False   
    End If   
End Sub



謝謝各位大大！
作者: dafa    時間: 2012-6-3 01:34

回復 27# dechiuan999


    我剛剛試了一下程式沒問題
好像你的資料第886列有問題
你把886列刪除試試看
什麼原因我不知道
可能要g大幫你解釋了
小弟才疏學淺只能幫到這裡了
作者: dafa    時間: 2012-6-3 01:36

回復 26# GBKEE


    感謝g大又再幫了我一次
作者: GBKEE    時間: 2012-6-3 09:24

本帖最後由 GBKEE 於 2012-6-3 10:01 編輯

回復 27# dechiuan999
複製 test 工作表 會有答案的
設訂 mSht1=複製的工作表  可正常運作   

For Each E In mSht1.Range("a1", mSht1.Range("a1:d900")).Columns(1).Cells     '測試到 800 的位置是 OK
-> For Each E In  mSht1.Range("a1:d900").Columns(1).Cells
作者: c_c_lai    時間: 2012-6-3 09:39

回復 7# GBKEE
請問 Option Compare Text 要加在 ThisWorkbook 還是  UserForm1 內？
作者: GBKEE    時間: 2012-6-3 09:54

回復 31# c_c_lai
Option Compare 陳述式必須出現在模組裏，且必須在任何程序之前。
你的程式碼在那裡 那裡的程序如果有 Option Compare  的設定為主
作者: dechiuan999    時間: 2012-6-3 17:24

謝謝版主大大。
小弟依版主大大的提示
做了如下的改變
一、複製TEST工表並且
將工作表命名為"IV"
set mSht1=worksheets("IV")
二、改為
For Each E In  mSht1.Range("a1:d900").Columns(1).Cells
三、以a1:d900的範圍為主執行結果如下：
輸入一個字元時
可執行→F、J、Q、V、Z
不可執行→A、C、E、G、H、L、M、N、O、R、T、U、W、Y
            '執行階段錯誤：13 型態不符合
查詢結果空白→B、D、I、K、P、S、X
四、小弟也使用轉換函數CSTR將
第一欄做一轉換也是徒勞無功。

因此，複製TEST工表並且
將工作表命名為"IV"
小弟也實在看不出有何改變
之呢？

依小弟的資質，我想是無法領
會版主的提示呢？
盼版主大大能再明示其差異之處。

感恩版主大大。
作者: GBKEE    時間: 2012-6-3 20:13

本帖最後由 GBKEE 於 2012-6-3 20:18 編輯

回復 33# dechiuan999
一、複製TEST工表並且   
如圖 複製

[attach]11244[/attach]
作者: Hsieh    時間: 2012-6-3 23:07

回復 33# dechiuan999
之所以陣列會出現錯誤，是因為儲存格內容字串長度超過256個字元所導致
A886含有276個字元
超出了EXCEL的規格限制
作者: dechiuan999    時間: 2012-6-4 04:33

本帖最後由 dechiuan999 於 2012-6-4 08:35 編輯

謝謝二位版主大大。

GBKEE版主大大提供的移動複製→建立副本
是一個好方法。也是小弟第一次學習到
如何使用到它的方式。更重要的是
它會出現警語。因此，也就是說
如果要避免此問題的出現，小弟想到有二個方式
一、
就是在MDB資料庫取出之前，利用SQL語法
針對取出之貨名引用MID就可限制取出字串長度
二、
對工作表COPY至另一工作表之後訧可排除255字元了。


HSIEH大大：
下列說明：
之所以陣列會出現錯誤，是因為儲存格內容字串長度超過256個字元所導致
A886含有276個字元
超出了EXCEL的規格限制

小弟不明白的地方是，
如果儲存格有字串長度的限制，
為何還能由資料庫轉入呢？
.Range("a1").CopyFromRecordset mRst

感恩二位大大。



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