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

handsometrowa

請問各位版上大師，小弟初學VBA
思考一個檔案問題已經許久，也爬了很多文章
嘗試用迴圈抓出資料...失敗..
嘗試用陣列抓出資料....也失敗...  想了好幾天弄不出來
想請問版上大人們   

如果我想要抓取一份資料  第一個sheet 是總表(會隨網頁更新抓資料)
如何使用VBA 將他分類變成 sheet2 . 3 .4 的分類呢?  
我將我要的資料區域 變成紅色的字樣  可以請人指導嗎?  

另外最重要的就是  第一個總表的資料列數 會隨著月份不同  而有數量不同
另外  是不是能在  更細分成 sheet 4  跟 5 的種類呢??

另外我在VBA編輯器那邊有留下我的想法.....各位請用力鞭打...我到底是哪裡的觀念不對??

拜謝各位大師~

GBKEE

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

1. Option Explicit
   
2. Dim Rng As Range, AR()
   
3. Sub Main()
   
4.     AR = Array("到期月份", "履約價", "買賣權", "成交量", "未沖銷契約量")
   
5.     With Sheets("選擇權總表")
   
6.         .[L4:M4] = Array("成交量", "未沖銷契約量")         '"*成交量" ,"*未沖銷'資料庫欄"*" 進階篩選有會有錯誤
   
7.         Set Rng = .Range("B4:Q" & .[B4].End(xlDown).Row)   '資料庫
   
8.         篩選程式 "分類一"
   
9.         篩選程式 "賣權"
   
10.         篩選程式 "買權"
    
11.         .Activate
    
12.     End With
    
13. End Sub
    
14. Private Sub 篩選程式(Sh As String)                  'SH參數為字串型態 :工作表名稱
    
15.     Dim T As String
    
16.     With Sheets(Sh)
    
17.         .Cells.Clear                                '儲存格:清除
    
18.         .[L1].Value = AR(0)                         '進階篩選: CriteriaRange,準則欄位名稱("到期月份")
    
19.         .[A1:E1].Value = AR                         '進階篩選: CopyToRange,複製到儲存格的欄位名稱
    
20.         
    
21.         If Sh = "賣權" Or Sh = "買權" Then
    
22.             .[L1].Value = AR(2)                     '進階篩選: CriteriaRange,準則欄位名稱("買賣權")
    
23.             .[L2] = IIf(Sh = "買權", "Call", "Put") '進階篩選:準則欄位 設立條件
    
24.         End If
    
25.         Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.[L1:L2], CopyToRange:=.[A1:E1], Unique:=True
    
26.         .[L1:L2] = ""                                'Unique:=True 僅篩選唯一的記錄
    
27.          If Sh <> "賣權" And Sh <> "買權" Then
    
28.             .Rows(2).Delete                          '資料庫第2列為 (週別) 不需要刪掉
    
29.         Else
    
30.             月份契約篩選程式 Sh
    
31.         End If
    
32.     End With
    
33. End Sub
    
34. Private Sub 月份契約篩選程式(Sh As String)
    
35.     Dim R As Range
    
36.     On Error GoTo ER:                               '程式錯誤處裡:月份契約買權的工作表,如不存在會有錯誤.
    
37.     With Sheets(Sh)
    
38.         .Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
    
39.         '篩選 [到期月份]在工作表最右端的欄位
    
40.         For Each R In .Range(.Cells(2, .Columns.Count), .Cells(2, .Columns.Count).End(xlDown))  '最右端的欄位的[到期月份]
    
41.             .Range("A1").AutoFilter Field:=1, Criteria1:=R     '自動篩選: A欄 準則= [到期月份]
    
42.             .Range("A:E").Copy Sheets(R & Sh).[A1]             '不符合準則的資料會隱藏掉
    
43.         Next
    
44.     End With
    
45.     Exit Sub                                                   '離開這程序
    
46. ER:
    
47.     If Err.Number = 9 Then                                      '月份契約買權的工作表
    
48.         Sheets.Add Sheets(Sheets.Count)                         '新增工作表
    
49.         ActiveSheet.Name = R & Sh                               '工作表:命名
    
50.         Resume                                                  '回到程式錯誤點
    
51.     End If
    
52.     MsgBox Err.Description & Err.Number                         '告知:不是工作表不存在會有錯誤.
    
53. End Sub

複製代碼

handsometrowa

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

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

GBKEE

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

Sub Main()  
建立資料庫範圍   

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

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

handsometrowa

回復 4# GBKEE


    再次拜謝!!  

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

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

感謝版主~

handsometrowa

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

Sub Main()
    AR = Array("到期月份", "履約價", "買賣權", "成交量", "未沖銷契約量")我懂
    With Sheets("選擇權總表")我懂
        .[L4:M4] = Array("成交量", "未沖銷契約量")    有點不懂，這句話的意思是把陣列變數中的這兩個變數賦值給 [L4:M4] ? 不是應該相反??     '"*成交量" ,"*未沖銷'資料庫欄"*" 進階篩選有會有錯誤
        Set Rng = .Range("B4" & .[B4].End(xlDown).Row)   '資料庫 這個資料庫範圍定義我懂
        篩選程式 "分類一"  那這個  篩選程式 以下這三個 分類一 賣權 買權 ?? 這是什麼指令   call?呼叫? 我看他不是注解 應該事會執行的程式吧?
        篩選程式 "賣權"
        篩選程式 "買權"

GBKEE

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

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

複製代碼

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

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

handsometrowa

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


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

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

GBKEE

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

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

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

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

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

複製代碼

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

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

handsometrowa

回復 9# GBKEE


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

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

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

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

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

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

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

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