12
返回列表 上一主題 發帖

[原創] 以關鍵字篩選多個sheets的資料

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-5-10 01:33 | 只看該作者

[原創] 以關鍵字篩選多個sheets的資料

這是使用VBA的方法, 過幾天再做個用函數(不用VBA)的方法

sonny1.gif
search record by keyword - Sonny_VER1.rar (21.89 KB)
收藏 分享
ss

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
2#
發表於 2013-5-11 09:19 | 只看該作者
回復 1# sunnyso

寫的不錯，構想也不錯

如果一開始沒有篩選關鍵字時，如何改為全部顯示

目前一列關鍵字的關係式是 AND，是否能多幾列為 OR
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
3#
發表於 2013-5-11 16:10 | 只看該作者
回復  sunnyso

寫的不錯，構想也不錯

[1] 如果一開始沒有篩選關鍵字時，如何改為全部顯示

目前一列關 ...
ML089 發表於 2013-5-11 09:19


[1] 在 For Each sh In all_datasheets的Next 前加入, "Cells(dst_row, 1).Resize(src_rows, clmn1) = tmp_data" 即可

[2] 若要用OR 就要改動多一些代碼, 過兩天改一下放上來.
  1.     For Each sh In all_datasheets
  2. ......
  3. ......
  4.         Cells(dst_row, 1).Resize(src_rows, clmn1) = tmp_data
  5.     Next
複製代碼
ss

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
4#
發表於 2013-5-11 16:19 | 只看該作者
回復 3# sunnyso


    改成這樣好用多了

表頭我設好字型與顏色，只要一執行VBA後就會被清除? 有辦法不被清除嗎?
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
5#
發表於 2013-5-12 02:50 | 只看該作者
回復  sunnyso


    改成這樣好用多了

表頭我設好字型與顏色，只要一執行VBA後就會被清除? 有辦法不 ...
ML089 發表於 2013-5-11 16:19


1. 在AA欄設計表頭的字型與顏色等 (VBA Sheet)
2. 添加VBA OR篩選，在關鍵字前加#
3. 添加非VBA方法，當中沒有使用陣列和陣列函數（如small, min等），以及盡量避免使用IF函數（因此篩選後的資料順序是3個sheets交錯）。以免資料增加會令計算過長。

請指教。


search record by keyword - Sonny.rar (37.13 KB)
ss

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
6#
發表於 2013-5-12 06:36 | 只看該作者
回復 5# sunnyso

>1. 在AA欄設計表頭的字型與顏色等 (VBA Sheet)
沒有試成功

>2. 添加VBA OR篩選，在關鍵字前加#
這部分用的有點不順
如能像高階篩選方式比較簡單，同一列為AND，不同列為OR
VBA可以再同一列以 ";" 區分為不同列方式，
例如
小項=早;午，S=A 表示取出 OR(AND(小項=早,S=A), AND(小項=午,S=A))
小項=早;午，S=A;B 表示取出 OR(AND(小項=早,S=A), AND(小項=午,S=B))

>3. 添加非VBA方法，當中沒有使用陣列和陣列函數（如small, min等），以及盡量避免使用IF函數（因此篩選後的資料順序是3個sheets交錯）。以免資料增加會令計算過長。
公式大概只能這樣做，全部先引用過來篩選   


以前用巨集練習過此類問題，看你使用VBA來處理所以特別有興趣。如果你累了不用管我的需求。謝謝
以前是分解動作
1. 將各Sheets資料複製再一起
2. 上方預留五行用高級篩選方處理，資料填完後按鈕由巨集來啟動高級篩選(半自動方式)
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
7#
發表於 2013-5-12 19:54 | 只看該作者
回復  sunnyso

寫的不錯，構想也不錯

如果一開始沒有篩選關鍵字時，如何改為全部顯示

目前一列關 ...
ML089 發表於 2013-5-11 09:19

回復 3# sunnyso
Private Sub Worksheet_Activate()
    ' ....
    ' ....
    Cells.ClearContents
    ' ....
    ' ....
    ' ....
    Next
    '  設定無篩選關鍵字輸入，每次啟動該頁面即顯示全部內容
    '  以下Null("")宣告，系統會自動觸發Worksheet_Change()
    Cells(4, 1) = ""   
    Application.ScreenUpdating = True
End Sub

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
8#
發表於 2013-5-12 19:54 | 只看該作者
回復 6# ML089

1. 設置表頭格式 (見下圖)

2. 很好的建議, 有時間再作修改

3. 由於某種特殊情況下, 不能使用有巨集的檔案, 所以才設計該方案, 放上來跟大家分享.

sonny2.gif
ss

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2013-5-12 21:34 | 只看該作者
本帖最後由 GBKEE 於 2013-5-12 21:36 編輯

回復 5# sunnyso
你的程式改用自動篩選 試試看
  1. Option Explicit
  2. Private Sub Worksheet_Activate()
  3.     Dim Sh As Worksheet, E As Integer
  4.     Application.ScreenUpdating = False
  5.     Application.EnableEvents = False
  6.     AutoFilterMode = False
  7.     E = Cells(Rows.Count, "A").End(xlUp).Row
  8.     E = IIF(E = 5, 6, E)
  9.     Range("A6:E" & E).Clear
  10.     For Each Sh In Sheets(Array("DataSheet2", "DataSheet3", "DataSheet3"))
  11.         Sh.UsedRange.Offset(1).Copy Cells(Cells(Rows.Count, "A").End(xlUp).Row + 1, "A")            '合併資料
  12.     Next
  13.     E = Cells(Rows.Count, "A").End(xlUp).Row
  14.     Range("A5:E" & E).AutoFilter                '範圍設立,自動篩選.
  15.     For E = 1 To 5
  16.         Range("A5").AutoFilter E, , , , False   '自動篩選: 取消箭頭
  17.     Next
  18.     Application.EnableEvents = True
  19.     Application.ScreenUpdating = True
  20. End Sub
  21. Private Sub Worksheet_Change(ByVal Target As Range)
  22.     Dim M As Variant
  23.     Application.EnableEvents = False
  24.     If Target.Row = 4 And Target.Column <= 5 Then
  25.         M = Split(Target, "#")
  26.         If UBound(M) >= 1 Then   '
  27.            '自動篩選: 在關鍵字詞前加入【#】將以OR來篩選該欄。
  28.             Range("A5").AutoFilter Target.Column, "=*" & M(0) & "*", xlOr, "=*" & M(1) & "*"
  29.         Else
  30.             Range("A5").AutoFilter Target.Column, "=*" & Target & "*"
  31.         End If
  32.     End If
  33.     Application.EnableEvents = True
  34. End Sub
  35. Private Sub Worksheet_SelectionChange(ByVal Target As Range)  '第4列輸入後返回第4列
  36.     Application.EnableEvents = False
  37.     If Target.Row = 5 And Target.Column <= 5 Then
  38.         Selection.Offset(-1).Select         'Target.Offset(-1).Select
  39.     End If
  40.     Application.EnableEvents = True
  41. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
10#
發表於 2013-5-12 22:25 | 只看該作者
回復  sunnyso
Private Sub Worksheet_Activate()
    ' ....
    ' ....
    Cells.ClearContent ...
c_c_lai 發表於 2013-5-12 19:54


Cells.ClearContent並不會觸動 worksheet_change
ss

TOP

        靜思自在 : 改變自己是自救，影響別人是救人。
12
返回列表 上一主題