VBA如何將不同資料的區域抓出分類?

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

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

2^#

發表於 2013-5-23 17:13 | 只看該作者

回復 1# handsometrowa
資料區域變成紅色的字樣 ,錄製巨集試試看

Option Explicit
Dim Rng As Range, AR()
Sub Main()
AR = Array("到期月份", "履約價", "買賣權", "成交量", "未沖銷契約量")
With Sheets("選擇權總表")
.[L4:M4] = Array("成交量", "未沖銷契約量") '"*成交量" ,"*未沖銷'資料庫欄"*" 進階篩選有會有錯誤
Set Rng = .Range("B4:Q" & .[B4].End(xlDown).Row) '資料庫
篩選程式 "分類一"
篩選程式 "賣權"
篩選程式 "買權"
.Activate
End With
End Sub
Private Sub 篩選程式(Sh As String) 'SH參數為字串型態 :工作表名稱
Dim T As String
With Sheets(Sh)
.Cells.Clear '儲存格:清除
.[L1].Value = AR(0) '進階篩選: CriteriaRange,準則欄位名稱("到期月份")
.[A1:E1].Value = AR '進階篩選: CopyToRange,複製到儲存格的欄位名稱
If Sh = "賣權" Or Sh = "買權" Then
.[L1].Value = AR(2) '進階篩選: CriteriaRange,準則欄位名稱("買賣權")
.[L2] = IIf(Sh = "買權", "Call", "Put") '進階篩選:準則欄位設立條件
End If
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.[L1:L2], CopyToRange:=.[A1:E1], Unique:=True
.[L1:L2] = "" 'Unique:=True 僅篩選唯一的記錄
If Sh <> "賣權" And Sh <> "買權" Then
.Rows(2).Delete '資料庫第2列為 (週別) 不需要刪掉
Else
月份契約篩選程式 Sh
End If
End With
End Sub
Private Sub 月份契約篩選程式(Sh As String)
Dim R As Range
On Error GoTo ER: '程式錯誤處裡:月份契約買權的工作表,如不存在會有錯誤.
With Sheets(Sh)
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
'篩選 [到期月份]在工作表最右端的欄位
For Each R In .Range(.Cells(2, .Columns.Count), .Cells(2, .Columns.Count).End(xlDown)) '最右端的欄位的[到期月份]
.Range("A1").AutoFilter Field:=1, Criteria1:=R '自動篩選: A欄準則= [到期月份]
.Range("A:E").Copy Sheets(R & Sh).[A1] '不符合準則的資料會隱藏掉
Next
End With
Exit Sub '離開這程序
ER:
If Err.Number = 9 Then '月份契約買權的工作表
Sheets.Add Sheets(Sheets.Count) '新增工作表
ActiveSheet.Name = R & Sh '工作表:命名
Resume '回到程式錯誤點
End If
MsgBox Err.Description & Err.Number '告知:不是工作表不存在會有錯誤.
End Sub

複製代碼

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

帖子: 82
主題: 7
精華: 0
積分: 112
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 20
性別: 男
註冊時間: 2013-1-3
最後登錄: 2020-9-21

3^#

發表於 2013-5-24 10:16 | 只看該作者

深深的感謝版主，說真的我看到的時候昏了....
我腦中的想法怎麼寫出來這麼複雜
我的功力真的離這個階段好遠好遠...

可否請版主跟我解釋一下大致上的流程
您是怎麼構思又怎麼處理這些問題的先來後到的@@?

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

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

4^#

發表於 2013-5-24 10:57 | 只看該作者

回復 3# handsometrowa
不要喪氣,我有這能力為你解答,是費了很多時間所磨練出來的.
有問題歡迎提問,多看,多練習範例,會進步的

Sub Main()
建立資料庫範圍

Sub 篩選程式(Sh As String)
依傳送的參數Sh(工作表名稱)指定到工作表物件: With Sheets(Sh)
修訂進階篩選, CriteriaRange[篩選準則],欄位名稱( "到期月份","買賣權" ),
                                 [篩選準則],欄位設立條件 .[L2] = IIf(Sh = "買權", "Call", "Put")

Sub 月份契約篩選程式(Sh As String)
依照Sh="賣權"或是Sh="買權",新增同一月份的契約的工作表

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

帖子: 82
主題: 7
精華: 0
積分: 112
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 20
性別: 男
註冊時間: 2013-1-3
最後登錄: 2020-9-21

5^#

發表於 2013-5-24 11:11 | 只看該作者

回復 4# GBKEE

再次拜謝!!

您真的是幫了很大的忙，拿到這份程式碼的時候，內心是又感動，又羞愧..

希望有朝一日早點完成我的東西可以幫忙更多人

感謝版主~

帖子: 82
主題: 7
精華: 0
積分: 112
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 20
性別: 男
註冊時間: 2013-1-3
最後登錄: 2020-9-21

6^#

發表於 2013-6-5 11:20 | 只看該作者

Dear  版大
我最近在拚命的統計資料阿我遇到難題了可不可以請問您(因為我還不夠權限發短訊)
您教導我的程式碼當中

Sub Main()
AR = Array("到期月份", "履約價", "買賣權", "成交量", "未沖銷契約量")我懂
With Sheets("選擇權總表")我懂
      .[L4:M4] = Array("成交量", "未沖銷契約量") 有點不懂，這句話的意思是把陣列變數中的這兩個變數賦值給 [L4:M4] ? 不是應該相反?? '"*成交量" ,"*未沖銷'資料庫欄"*" 進階篩選有會有錯誤
      Set Rng = .Range("B4

" & .[B4].End(xlDown).Row) '資料庫這個資料庫範圍定義我懂
      篩選程式 "分類一"  那這個  篩選程式以下這三個分類一賣權買權 ?? 這是什麼指令 call?呼叫? 我看他不是注解應該事會執行的程式吧?
      篩選程式 "賣權"
      篩選程式 "買權"

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

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

7^#

發表於 2013-6-5 17:18 | 只看該作者

本帖最後由 GBKEE 於 2013-6-5 17:21 編輯

回復 6# handsometrowa
*成交量 *未沖銷 -> 資料庫欄位名稱不可以有 * ,會造成進階篩選不能執行會有錯誤.
.[L4:M4] = Array("成交量", "未沖銷契約量")
等同

.[L4] ="成交量"
.[M4]= "未沖銷契約量")

複製代碼

篩選程式 "分類一" '呼叫篩選程式這程序並且傳送參數型態為"字串"
篩選程式 "賣權"
篩選程式 "買權"

Private Sub 篩選程式(Sh As String)
'程式接收的(Sh)參數(String)型態為"字串"
With Sheets(Sh) -> Sheets("分類一")

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

帖子: 82
主題: 7
精華: 0
積分: 112
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 20
性別: 男
註冊時間: 2013-1-3
最後登錄: 2020-9-21

8^#

發表於 2013-6-6 09:40 | 只看該作者

感謝GBKEE ~我懂了但是可否再提問一個問題

這個Array ("成交量", "未沖銷契約量") 跟一開始設定的那個AR = Array("到期月份", "履約價", "買賣權", "成交量", "未沖銷契約量") 有關聯嗎? 我想我是這個地方出問題依照您的想法，
.[L4] ="成交量"
.[M4]= "未沖銷契約量") 只是把Range("L4") 賦值變成文字檔而已
所以跟一開始陳述陣列變數那五個的名稱有關係嗎?

.[L4:M4] = Array("成交量", "未沖銷契約量")
等同
.[L4] ="成交量"
.[M4]= "未沖銷契約量")

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

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

9^#

發表於 2013-6-7 15:52 | 只看該作者

本帖最後由 GBKEE 於 2013-6-7 15:56 編輯

回復 8# handsometrowa
跟一開始陳述陣列變數那五個的名稱沒有關係的

*成交量 *未沖銷 -> 資料庫欄位名稱不可以有 * ,去掉*的作用而已.

1#說:我想要抓取一份資料第一個sheet 是總表(會隨網頁更新抓資料)
如何使用VBA 將他分類變成 sheet2 . 3 .4 的分類呢?

我用了 [進階篩選]的方法

AdvancedFilter 方法 [進階篩選]
請參閱套用至範例特定基於準則範圍從資料清單中篩選或複製資料。如果初始選定為單個儲存格，則使用儲存格目前的區域x為Variant。
expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
expression 必選。該運算式會傳回 [套用於] 清單中的其中一個物件。
Action 必選的 XlFilterAction 資料類型。
XlFilterAction 可以是這些 XlFilterAction 常數之一。xlFilterCopy ,xlFilterInPlace.
CriteriaRange 選擇性的 Variant。準則範圍。如果省略此引數則無準則。
CopyToRange 選擇性的 Variant。如果 Action 為 xlFilterCopy，此引數指定被複製列的目標範圍。否則忽略此引數。
Unique 選擇性的 Variant。若為 True，則僅篩選唯一的記錄；若為 False，則篩選出所有符合準則的記錄。預設值為 False。

複製代碼

[選擇權總表] 為資料庫以下為它的欄位名稱
契約到期月份履約價買賣權開盤價最高價最低價最後結算價漲跌價漲跌% *成交量 *未沖銷最後最佳買價最後最佳賣價歷史最高價歷史最低價

[選擇權總表]中指定要篩選的欄位,用 AR = Array("到期月份", "履約價", "買賣權", "成交量", "未沖銷契約量") ,一次的複製到
sheet2 . 3 .4 中,便於AdvancedFilter的篩選.

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

帖子: 82
主題: 7
精華: 0
積分: 112
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 20
性別: 男
註冊時間: 2013-1-3
最後登錄: 2020-9-21

10^#

發表於 2013-7-3 12:25 | 只看該作者

回復 9# GBKEE

Dear GBKEE
感謝您之前給的程式碼，做出來的東西符合我要的東西，但是後續還可能要添加自動計算

我今天把整個程式分開看了一下，在自動篩選的地方我真的完全不了解，我今天去EXCEL 看了說明

在定義一個範圍名稱也好，選取一個範圍也好，在使用進階篩選的時候，給予準則並且複製到某個地方的時候..

他都只能在同一個工作表上面使用篩選後的準則條件複製並且貼上，不能跨工作表貼上阿@@"

可是我今天用了條列式偵錯跑程式，可是您一開始資料庫定義完之後，就可以把篩選過後的資料貼到"買權"或是"賣權" 的工作表裡面

然後再進行進一步的篩選，然後再貼上到新增加的名稱工作表上

這真的百思不得其解阿!! EXCEL不能進階篩選後貼到別的工作表，可是VBA可以?

PS:其實您幫我設計的程式 "買權"跟"賣權" 可以需要可以不要，"分類一"那個是當初解釋用其實不用那個工作表了，註記程式碼之後可以繼續運行，感謝^^