返回列表 上一主題 發帖

[發問] 可自定表單 全文檢索?

回復 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 並按下滑鼠鍵,可選取或取消選取一個專案。

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

TOP

回復 23# GBKEE


    很感謝G大的協助解答
G大的功力真是博大精深
趕快來去消化一下

TOP

回復 23# GBKEE


   請問G大
我剛剛試了一下結果挑選第2筆資料時
Label2.Caption的第一筆資料與第二筆資料都變成同一筆資料了

TOP

回復 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
複製代碼

TOP

CARGOTEST.rar (111.32 KB) 各位大大好:

  版主大大提供的全文檢索
功能實在太好用了。
  但是小弟有一問題一直無法
突破,想請各位大大幫小弟如何
克服此項問題。
  小弟是直接由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



謝謝各位大大!

TOP

回復 27# dechiuan999


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

TOP

回復 26# GBKEE


    感謝g大又再幫了我一次

TOP

本帖最後由 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

TOP

回復 7# GBKEE
請問 Option Compare Text 要加在 ThisWorkbook 還是  UserForm1 內?

TOP

回復 31# c_c_lai
Option Compare 陳述式必須出現在模組裏,且必須在任何程序之前。
你的程式碼在那裡 那裡的程序如果有 Option Compare  的設定為主

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題