1234
返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
21# 跳轉到 »
發表於 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
複製代碼

TOP

dafa

帖子
49 
主題
6 
精華
0 
積分
97 
點名
0  
作業系統
xp 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-8-24 
最後登錄
2023-12-24 
22#
發表於 2012-6-1 15:10 | 只看該作者
回復 23# GBKEE


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

TOP

dafa

帖子
49 
主題
6 
精華
0 
積分
97 
點名
0  
作業系統
xp 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-8-24 
最後登錄
2023-12-24 
23#
發表於 2012-6-1 16:09 | 只看該作者
回復 23# GBKEE


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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
24#
發表於 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
複製代碼

TOP

dechiuan999

帖子
231 
主題
55 
精華
0 
積分
293 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
KEELUNG 
註冊時間
2010-7-24 
最後登錄
2018-8-28 
25#
發表於 2012-6-2 08:37 | 只看該作者
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

dafa

帖子
49 
主題
6 
精華
0 
積分
97 
點名
0  
作業系統
xp 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-8-24 
最後登錄
2023-12-24 
26#
發表於 2012-6-3 01:34 | 只看該作者
回復 27# dechiuan999


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

TOP

dafa

帖子
49 
主題
6 
精華
0 
積分
97 
點名
0  
作業系統
xp 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-8-24 
最後登錄
2023-12-24 
27#
發表於 2012-6-3 01:36 | 只看該作者
回復 26# GBKEE


    感謝g大又再幫了我一次

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
28#
發表於 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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
29#
發表於 2012-6-3 09:39 | 只看該作者
回復 7# GBKEE
請問 Option Compare Text 要加在 ThisWorkbook 還是  UserForm1 內？

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
30#
發表於 2012-6-3 09:54 | 只看該作者
回復 31# c_c_lai
Option Compare 陳述式必須出現在模組裏，且必須在任何程序之前。
你的程式碼在那裡 那裡的程序如果有 Option Compare  的設定為主

TOP

        靜思自在 : 話多不如話少，話少不如話好。
1234
返回列表 上一主題