1234
返回列表 上一主題 發帖

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

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

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

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

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

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

dechiuan999

帖子
231 
主題
55 
精華
0 
積分
293 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
KEELUNG 
註冊時間
2010-7-24 
最後登錄
2018-8-28 
20#
發表於 2012-6-1 13:11 | 只看該作者
dafa 大大您好：

謝謝您的說明。
感恩！

TOP

dafa

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


    只要你的 ListBox屬性Width<ColumnWidths就應該會自己出現了

TOP

dechiuan999

帖子
231 
主題
55 
精華
0 
積分
293 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
KEELUNG 
註冊時間
2010-7-24 
最後登錄
2018-8-28 
18#
發表於 2012-5-31 19:23 | 只看該作者
版主大大您好：

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

感謝您！

TOP

dafa

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


    感謝G大的解釋
如本範例
在請問G大如果我ListBox1屬性設定可複選
但我要如何將ListBox1所有挑選的資料放到Label2呢

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
16#
發表於 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) '第二次轉置 得到的是  整列資料   
複製代碼

TOP

        靜思自在 : 人要知福、惜福、再造福。
1234
返回列表 上一主題