返回列表 上一主題 發帖

[發問] 多筆EXCEL搜尋的用法[已解決 2011-05-11]

[發問] 多筆EXCEL搜尋的用法[已解決 2011-05-11]

本帖最後由 mark15jill 於 2011-5-11 15:06 編輯

如題..
因資料數很多,想說用一個EXCEL VBA 將其關鍵字搜尋出來 並且 另存一份新的EXCEL檔案
如附檔...
能.rar (28.27 KB)

方便的話,能否在能更改的地方加註一下,感恩!!
因有爬文 但是都只有 部份相關的資訊 並無統整的..
如看不懂 所附的檔案 請告知

本帖最後由 GBKEE 於 2011-5-10 11:04 編輯

回復 1# mark15jill
需求說明:
   1.想利用 在text內 輸入查詢的鄉鎮(如 台灣 )  再按 查詢 查詢的結果從 第三列(A3)開始將該資料列出來。
     如範例:要查詢 台灣 的話        (資料順序並非按照 123 這樣下去  有可能是跳號 20   25  30 27 等等。   
你的檔案是簡略的範例    請問:
1.要搜尋的檔案是同一目錄下的檔案嗎?  ,存檔在同一目錄下嗎?
2.資料號碼 是找到 台灣的列號嗎?    台灣 同一列往右有資料嗎? 要一起抓嗎?
3.範例 可以再實際些嗎?

TOP

是要將各年度活頁簿中,每個工作表的I欄,符合關鍵字條件的資料全部找出來
然後把這些資料的出處資料另存活頁簿嗎?
實在看不懂你的範例,要如何與你的說明配合起來
請將各年度檔案填入數據
然後把想要的結果樣式做成工作表,再配合說明
學海無涯_不恥下問

TOP

本帖最後由 mark15jill 於 2011-5-10 11:30 編輯

回復 2# GBKEE

抱歉 是我表達不好
在這說一次..
再查詢的活頁簿內的 TEXT 輸入 所要查詢的字樣
然後 按下查詢的COMBO的按鈕
則將  97  98 99 年度 所符合的 地址(例如台灣字眼的) 列在 A3 那列  (相關的案例 有重附上檔案)
列出的資料 包含 該資料的所有 “列資料 - 如第一筆的話就是 在a3 b3 c3 d3 e3 這一列 ”
然後 如果按下儲存的按鈕
就會將 查詢的字樣 儲存為新的活頁簿  (目錄路徑與查詢的目錄同一個)  EXCEL檔案及活頁簿 名稱為 查詢的字樣
如 查詢 台灣
則 台灣 這個EXCEL名稱 和 活頁簿名稱 均為 台灣   儲存路徑 與 “查詢 EXCEL檔案” 同樣目錄
不曉得這樣是否比較清楚..



我在重附一份格式的資料(大概格式)

    能.rar (29.55 KB)

TOP

回復 4# mark15jill
  1. Private Sub 查詢()
  2.     Dim Text$, File$, TheSh As Object, Sh As Worksheet, Rng As Range, RngAddress$
  3.     With ThisWorkbook            '程式碼置於查詢總表.xls
  4.         Set TheSh = .Sheets("查詢")
  5.         TheSh.UsedRange.Offset(2).Clear
  6.         File = Dir(.Path & "\*年度*.xls")
  7.         Do While File <> ""
  8.             With Workbooks.Open(.Path & "\" & File)
  9.                 For Each Sh In .Sheets
  10.                     Set Rng = Sh.Range("e:e").Find(TheSh.TextBox1, LookAt:=xlWhole)
  11.                     If Not Rng Is Nothing Then
  12.                         RngAddress = Rng.Address
  13.                         With TheSh.Range("C" & Rows.Count).End(xlUp)
  14.                             .Offset(1, -2) = File
  15.                             .Offset(1, -1) = Sh.Name
  16.                         End With
  17.                     End If
  18.                     Do While Not Rng Is Nothing
  19.                         With TheSh.Range("C" & Rows.Count).End(xlUp)
  20.                             .Offset(1).Resize(1, 6) = Sh.Range(Sh.Cells(Rng.Row, "A"), Sh.Cells(Rng.Row, "F")).Value
  21.                         End With
  22.                         Set Rng = Sh.Range("e:e").FindNext(Rng)
  23.                         If RngAddress = Rng.Address Then Exit Do
  24.                     Loop
  25.                 Next
  26.             .Close 0
  27.             End With
  28.             File = Dir
  29.         Loop
  30.     End With
  31. End Sub
  32. Sub 存檔()              '程式碼置於查詢總表.xls
  33.     Dim Sh As Object
  34.     On Error Resume Next
  35.     Set Sh = ThisWorkbook.Sheets(1)
  36.    
  37.     With Workbooks.Add(xlWBATWorksheet)
  38.         Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]
  39.         .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1
  40.         .Close 0
  41.     End With
  42. End Sub
複製代碼

TOP

本帖最後由 mark15jill 於 2011-5-10 15:21 編輯

回復 5# GBKEE

GBKEE 大大不好意思 剛剛測試
發現以下幾個問題
1.控制鈕 變成無效 (僅能巨集控制)
2.存檔仍然有疑惑 無存檔動作
3.如果條件改成 美國的話 (預設是台灣)  就沒辦法有存檔的動作出現

順帶一問..
我那個按鈕弄對嗎= =!! 因為 有ACTIVE 和 另外一種  我常常都會搞混

附上測試後的資料夾

能.rar (25.92 KB)

TOP

本帖最後由 GBKEE 於 2011-5-10 15:42 編輯

回復 6# mark15jill
1.控制鈕 變成無效 (僅能巨集控制)
指定按鈕巨集  請看如圖

EX1.GIF
2011-5-10 15:32

Sub 存檔()               -> 公用會顯示
Private Sub 查詢()    -> 私用(Private)不會顯示
要用: 依樣畫葫蘆 打上 Sheet1.查詢

2.存檔仍然有疑惑 無存檔動作   
目錄裡沒此檔案 直接就存檔

3.如果條件改成 美國的話 (預設是台灣)  就沒辦法有存檔的動作出現
存二次 美國 看看

TOP

本帖最後由 mark15jill 於 2011-5-10 16:06 編輯

回復 7# GBKEE

1.兩個都沒內容+.+
Sub 按鈕5_Click()

End Sub
Sub 按鈕6_Click()

End Sub

2.已經解決無法存檔 和 無效問題QQ  謝謝您
剛剛把程式分開裝...
拆成兩部份丟去兩邊..

3.新增後的活頁簿名稱未改變.. 不過剛剛已經解決了..
原本是sheet1.  我多+了兩行..
   

        .Close 0
          Sheets("Sheet1").Select
         Sheets("Sheet1").Name = Sh.TextBox1


4.另外請問一下  
如果那樣的話 那是只要同一列的資料 不管有多少 都會列出來嗎??
因為我範例檔案只有到H欄位   實際上卻是到Z欄位0.0..

再次感謝您  :lol

TOP

回復 8# mark15jill
1.兩個都沒內容+.+     
沒有程式碼阿, 會有動作嗎?
3.新增後的活頁簿名稱未改變.. 不過剛剛已經解決了..
  1. Private Sub 存檔()
  2. Dim Sh As Object
  3. On Error Resume Next
  4. Set Sh = ThisWorkbook.Sheets(1)
  5. With Workbooks.Add(xlWBATWorksheet)
  6. Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]
  7. .Sheets(1).Name = Sh.TextBox1      '工作表名稱
  8. .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1
  9. .Close 0
  10. End With
  11. End Sub
複製代碼

4.因為我範例檔案只有到H欄位   實際上卻是到Z欄位0.0..
改紅字部位
.Offset(1).Resize(1,26) = Sh.Range(Sh.Cells(Rng.Row, "A"), Sh.Cells(Rng.Row, "Z")).Value

TOP

回復 9# GBKEE

1.當然沒動作XD!!    因為不知道要怎寫 所以 ... 不過現在已經解決了 謝謝
3.那個原始碼 是套用大大您的   可是 剛有試驗過 不能 不過後來有新增我列的兩行 就OK了...就是sheet1 變成 TEXT名稱  (不知道哪出錯-0-)
4.了解那行的意思了... 謝謝...

TOP

        靜思自在 : 能付出愛心就是福,能消除煩惱就是慧。
返回列表 上一主題