台灣最大程式設計社群網站
線上人數
1751
 
會員總數:239099
討論主題:185534
歡迎您免費加入會員
討論區列表 >> office VBA / WinOS >> 如何根據篩選的條件貼上另個sheet??
[ 變換順序 ]  
[我要回覆]
1
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
如何根據篩選的條件貼上另個sheet??
價值 : 50 QP  點閱數:188 回應數:6

樓主

Jay
門外漢
0 6
112 7
發送站內信


第一頁的sheet
想根據篩選專案的名稱AA OT PP根據月份填入第二頁的sheet

小的不才只能找到相關的程式碼做尋找但是無法貼上懇請各位大神協助!
https://drive.google.com/file/d/0Bzu-awywPz20VGppQW91T1ota1E/view?usp=sharing
附上excel


'自己選定欄位,輸入該欄位要搜尋的資料,將找到的資料產生到新資料頁

Sub SearchDataToNewSheet()

Dim SearchColumn, SearchData
SearchColumn = InputBox("請輸入要尋找的第幾個欄位")
SearchData = InputBox("請輸入該欄位要找的資料內容")
'SearchData = InputBox("請輸入業務人員名稱")

'指定來源資料頁,為固定頁,在第一頁
Sheets(1).Select
'起點位置
Range("A1").Select
'進入搜尋模式
Selection.AutoFilter
'設定搜尋範圍,從指定欄尋找
'"$A$1:$L$12500" 可改由使用者輸入,組合成字串,這樣搜尋就不會被設限,不必再調修程式碼
ActiveSheet.Range("$A$1:$L$12500").AutoFilter Field:=SearchColumn, Criteria1:=SearchData
'將搜尋到的資料選取並複製下來
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
'新增一張資料表在最後面,並將資料貼到新頁

End Sub

搜尋相關Tags的文章: [ 篩選 ] , [ vba ] , [ 月份 ] , [ 判斷 ] ,
本篇文章發表於2016-12-31 22:01
別忘捐VP感謝幫助你的人 新手會員瞧一瞧
1樓
回應

Sdany
捐贈 VP 給 Sdany 檢舉此回應
用篩選不完全是你要的答案

你的程式篩選完後直接 copy Paste 當然不會呈現你想要的樣子
還需要做一些判斷,再把值填入所要的格子內

你可以用 Sheet2 A 欄去跑 Sheet1 Row 迴圈比對
找到一樣的資料
在判斷 Column 的日期,是否為 Shhet2 B-J 欄的月份
再將單一個儲存格 copy Paste

另外,如果日期出現在同一個月份,要怎麼辦?
本篇文章回覆於2017-01-02 08:06
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
2樓
作者回應

Jay
檢舉此回應
非常感謝大大熱心回覆,請問有無相關文章可以作為參考?
目前的程度只能錄巨集做些小修改還沒有辦法從頭到尾撰寫

Sheet1


貼上sheet2


同月份沒有問題抱歉前面我的文章格是打錯了,同個階段都是於同個月上填上一樣的顏色的!
https://drive.google.com/file/d/0Bzu-awywPz20cHBWOTZBVnVsXzQ/view?usp=sharing
本篇文章回覆於2017-01-02 12:36
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
3樓
最有價值解答

roar
檢舉此回應
這是參考別人後修改的,如有問題再討論
Private Sub CommandButton1_Click()
'referance from 隨意窩

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim theRow As Range
Dim theArea As Range
Dim rng As Range
k = 2 '第2列sheets(2)由第2列開始放資料


With Sheets("Sheets(1)")
Set rng = .UsedRange '所有資料範圍
rng.AutoFilter Field:=1, Criteria1:="a*" '要呈現何筆資料再此修改

'設定篩選結果範圍,purge the first row
Set rng = rng.Resize(rng.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With

For Each theArea In rng.Areas
'遍歷各AREA的各列
For Each theRow In theArea.Rows
theRow.Select '選定此列
'rxxr 代表autofilter 後第一筆資料之即第一列 row 的位置,rxxc 代表column的位置,
rx = Split(theRow.Address(ReferenceStyle:=xlR1C1), ":", 2)(0) 'pick range from beginning and in the form of r1c1 not A1 ,先拆成2個字串,第1個為第1筆開始位置,第2個為第1筆結束位置
rxx = Split(rx, "R", 2)(1) 'for example R4C17,using R to split the string into two, the first one is "R" cotainer(0) and the second is "4C17" container(1)
rxxr = Split(rxx, "C", 2)(0) 'to extract 4 and 17 from "4C17",we split it again ,using C,and it turn to "4" and "17","4" is for (0),and "17" is for (1)
rxxc = Split(rxx, "C", 2)(1)
ry = Split(theRow.Address(ReferenceStyle:=xlR1C1), ":", 2)(1) 'pick range from ending
ryy = Split(ry, "R", 2)(1)
ryyr = Split(ryy, "C", 2)(0)
ryyc = Split(ryy, "C", 2)(1)

MsgBox ActiveWorkbook.Worksheets("Sheets(2)").UsedRange.Columns.Count
For i = rxxc To ryyc 'first test datatype,if it is date,matching the month of sheets(1)'s autofilter data with sheets(2) header
For j = 2 To ActiveWorkbook.Worksheets("Sheets(2)").UsedRange.Columns.Count
If VarType(ActiveWorkbook.Worksheets("Sheets(1)").Cells(rxxr, i)) = vbDate Then
If Month(ActiveWorkbook.Worksheets("Sheets(1)").Cells(rxxr, i).Value) = Month(ActiveWorkbook.Worksheets("Sheets(2)").Cells(1, j).Value) Then
ActiveWorkbook.Worksheets("Sheets(2)").Cells(k, j) = ActiveWorkbook.Worksheets("Sheets(1)").Cells(rxxr, i).Value
End If
Else
ActiveWorkbook.Worksheets("Sheets(2)").Cells(k, 1) = ActiveWorkbook.Worksheets("Sheets(1)").Cells(rxxr, i).Value 'put the first column data
End If
Next
Next
k = k + 1
Next
Next

End Sub
本篇文章回覆於2017-01-02 14:19
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
4樓
作者回應

Jay
檢舉此回應
我將k改為3開始放資料卻無法執行,懇求大大再行協助!

附上GOOGLE文件
文件

將sheet1


放入sheet2


本篇文章回覆於2017-01-02 15:12
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
5樓
回應

roar
檢舉此回應
有 sandy 提的問題,我的做法是由sheets(1)pick date and match with sheets(2) header,and put under the header,but in sheets(1) at the same row ,first row or second row ,there are cells of the same month,so you pick many cells in sheets(1) and put it into the only cell in sheets(2),if month data is more than 1 they will be overwirte and your data will lost.i can't do with it.
from your google cloud excel data
Tyche project 中有2個9月的資料,而sheets(2)中同一列Tyche project 9月份僅有一個儲存格。
本篇文章回覆於2017-01-02 16:31
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
6樓
作者回應

Jay
檢舉此回應
謝謝roar&Sdany 大大們的協助
本篇文章回覆於2017-01-11 11:38
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
[ 變換順序 ]   
1

回覆
如要回應,請先登入.