返回列表下一主題上一主題發帖

[發問] 如何搜尋不同分頁的相同名稱欄位(名稱無排序)並條列出來~

citizen0923

小學生 Rank: 1

帖子: 9
主題: 3
精華: 0
積分: 12
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 10
註冊時間: 2015-9-13
最後登錄: 2015-11-30

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2015-9-14 21:23 | 只看該作者

[發問] 如何搜尋不同分頁的相同名稱欄位(名稱無排序)並條列出來~

本帖最後由 citizen0923 於 2015-9-14 21:25 編輯

各位前輩好：

關於如何搜尋不同分頁的相同名稱欄位(名稱無排序)並條列出來，小弟不才已爬文兩三天還是不知從何下手~

目標如下:
--------
分頁A:[搜尋}
搜尋AAA
跳出
AAA 第1筆資料
AAA 第2筆資料
AAA 第3筆資料
--------
分頁B:[列表]
AAA 第1筆資料
BBB  第1筆資料
AAA 第2筆資料
--------
分頁C:[列表]
BBB 第1筆資料
AAA  第3筆資料
BBB 第2筆資料
--------
==============================
目前能試出來的方式只能在同一個分頁裡面達成這個功能
分頁A:[搜尋+列表}
AAA 第1筆資料
BBB  第1筆資料
AAA 第2筆資料

搜尋AAA
AAA 第1筆資料
AAA 第2筆資料

==============================
以上兩個檔案請參閱附件的

原始檔及目標.zip (17.6 KB)
==============================
還是想不透如何搜尋跨分頁的資料，
希望各位大大能夠幫忙指點迷津~~有勞前輩費心了謝謝

樓主熱帖

citizen0923

小學生 Rank: 1

帖子: 9
主題: 3
精華: 0
積分: 12
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 10
註冊時間: 2015-9-13
最後登錄: 2015-11-30

5^#

發表於 2015-9-20 01:49 | 只看該作者

前輩日安，參考VBA解法後已經可以正常使用了，真的不勝感激

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2833
主題: 10
精華: 0
積分: 2889
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-15

4^#

發表於 2015-9-15 17:05 | 只看該作者

基本的〔篩選〕法：

Sub 篩選貼入()
Dim xStr$, xS As Worksheet, xName$, xE As Range
With ActiveSheet
　　Range(.[A1], .UsedRange).Offset(4, 0).EntireRow.Delete
　　xName = .Name
　　xStr = .[B1]
　　If xStr = "" Then Exit Sub
End With
　
For Each xS In Sheets
　If xS.Name <> xName Then
　　　With xS.UsedRange
　　　　　.AutoFilter Field:=1, Criteria1:=xStr
　　　　　.Offset(1, 0).Copy [A65536].End(xlUp)(2)
　 End With
　　　xS.AutoFilterMode = False
　End If
Next
End Sub

複製代碼

　
附件下載：

Xl0000101.rar (10.48 KB)
　

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2015-9-15 09:34 | 只看該作者

本帖最後由 GBKEE 於 2015-9-15 09:35 編輯

回復 2# citizen0923
試試看

Option Explicit
Sub Ex()
Dim Sh As Worksheet, xlWord As String, Ar(), xAr(), i As Integer, x As Integer
xlWord = Sheets("查詢").Range("B1") '要查詢的編號
For Each Sh In Sheets 'Sheets: 活頁簿的工作表物件集合
If Sh.Name <> "查詢" Then
Ar = Sh.UsedRange.Value 'UsedRange(二維陣列): 工作表使用的範圍
For i = 1 To UBound(Ar)
If UCase(Ar(i, 1)) = UCase(xlWord) Then
ReDim Preserve xAr(x) '重置陣列元素的索引值,Preserve:保留原有的元素
xAr(x) = Application.Index(Ar, i) '讀取二維陣列中元素
x = x + 1
End If
Next
End If
Next
With Sheets("查詢").UsedRange.Offset(4) '這範圍下移4列的範圍
.Value = ""
If x > 0 Then
.Cells(1).Resize(x, UBound(Ar, 2)) = Application.Transpose(Application.Transpose(xAr))
Application.Transpose'轉置函數
End If
MsgBox "查詢 " & IIf(x = 0, "不到 ", "") & xlWord & IIf(x > 0, " OK!", "")
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

citizen0923

小學生 Rank: 1

帖子: 9
主題: 3
精華: 0
積分: 12
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 10
註冊時間: 2015-9-13
最後登錄: 2015-11-30

2^#

發表於 2015-9-15 01:55 | 只看該作者

不好意思~ 忘了提到要是有用VBA的解法也可喔~ 再麻煩大家了~~

TOP

靜思自在 : 口說一句好話，如口出蓮花；口說一句壞話如口吐毒蛇。

返回列表下一主題上一主題