[發問] 篩選資料並且放到新的Sheet裡

candy516

各位前輩你們好：
    我又有一個問題想要請教大家，是關於資料篩選的!我本來想用人工手動的方法一筆一筆篩選，但我的指導教授一直叫我寫程式= = 但我是個超級超級新手，也沒有正式學過VBA!Sheet1是每檔股票的除息日，Sheet2~11則是十年間每股的日報酬率。最後一個Sheet是我想要的結果。接下來我需要篩選出每一檔股票在除息日後14天的日報酬率(包含除息日共15天)。舉列來說，在Sheet1中2010的1234黑松它的除息日是20100719，則在Sheet2中將20100719~20100801黑松的日報酬率抓至一個新的Sheet中(包含日期也一起抓)。請問這樣繁瑣的步驟，VBA可以辦到嗎?
希望各位可以幫幫我!謝謝!

Hsieh

回復 32# candy516

假如你這些資料是從系統中或網路Download的
這已經是既成表格，但是這樣的資料排列在資料庫原則中牴觸了一列為一筆資料的原則
這樣的表格你無法使用EXCEL內建的篩選功能或樞紐分析表
老夏前輩的檔案中你會發現是將所有年度的資料
依照日期、股票名稱、價格
一筆一筆地在同一工作表中呈現
這樣你就很輕易地使用樞紐分析或是以篩選功能獲得想要的資料
所以要把你的表格整理成跟老夏前輩一樣的資料表
你覺得你要花多少時間跟體力才能完成
所以，如果你是逐筆資料KEY的建立資料表時
那麼直接做成老夏前輩的格式，是不是就可以少掉這個整理程序
這就是我所說擦屁股啦!
老夏前輩不知道擦好沒?他說還在努力待續呢

candy516

回復 31# Hsieh


終於解決這個問題了!= =
謝謝前輩~

candy516

前輩們好~
正規化是指將這些資料表單把整理成一定的格式嗎?是讓資料更有秩序嗎?!
所以說正規化是也需要用程式碼來執行還是說像是樞紐分析之類的嗎?
另外一問，“擦屁股”是什麼意思?
謝謝~^^

Hsieh

回復 28# candy516

正規化表格是根本解決之道
不過得要先擦完屁股喔

至於程式問題點是出在
Set C = .Columns("A").Find(d(ky), lookat:=xlWhole)
Set B = .Rows(1).Find(Split(ky, ",")(0), lookat:=xlPart)
加入搜尋參數就能正確找到資料了

candy516

回復 26# Hsieh


前輩您好：
    在附檔裡的SHEET1中，A5證券代碼為3009，我是想要抓出20050103後五天(含當天)，
所以正確應該抓取的資料為2005/1/7  -7.7104，但程式跑出來變成2005/11/9  7.402!
我研究一下發現，只要原始資料是1、2月的都是不對的耶!
又要麻煩您幫我解答一下，不好意思!
謝謝您!^^

candy516

回復 26# Hsieh


我也是想說是那邊的問題,我也做過修改!= =
但沒有成功， 所以是只要把格式改掉即可，對吧!
謝謝您唷!^^

Hsieh

回復 25# candy516

1. Sub ex()
   
2. On Error Resume Next
   
3. Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set sht = Sheets.Add(after:=Sheets(1))
   
6. Application.ScreenUpdating = False
   
7. With Sheet1
   
8.    For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
9.       mystr = A & "," & Left(A.Offset(, 1), 4)
   
10.      '你Sheet1的A欄是以日期格式yyyy/m/d輸入，但格式設成yyyymmdd，所以，造成非全部為8碼
    
11.    '用TEXT屬性得到所見字串
    
12.       d(mystr) = DateValue(Format(A.Offset(, 1).Text, "0000/00/00"))
    
13.       If Err.Number <> 0 Then MsgBox A & A.Offset(, 1)
    
14.    Next
    
15. End With
    
16. k = 1: r = 1
    
17. For Each ky In d.keys
    
18. y = Split(ky, ",")(1)
    
19. With Sheets(y)
    
20. Set C = .Columns("A").Find(d(ky))
    
21. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
22. If Not C Is Nothing And Not B Is Nothing Then
    
23. x = Application.Max(3, C.Row - 14)
    
24.    Set Rng = .Cells(x, 1).Resize(15, 1)
    
25.    Set Rng1 = .Cells(x, B.Column).Resize(15, 1)
    
26.    With sht
    
27.       Rng.Copy .Cells(r, k)
    
28.       Rng1.Copy .Cells(r, k + 1)
    
29.       .Cells(r, 3) = y & "年第" & B.Column - 1 & "筆"
    
30.    End With
    
31.    r = r + 15
    
32.    Else
    
33.    MsgBox "無此除權資料"
    
34. End If
    
35. End With
    
36. Next
    
37. Application.ScreenUpdating = True
    
38. End Sub

複製代碼

candy516

回復 23# Hsieh


   
前輩您好~
我現在又回歸到本主題一開始的程式碼，
我現在換篩選出沒填權股票的報酬率，我將檔案下載成一樣的格式，
但貼上程式碼執行後，它說型態不符!
請問是哪裡出了問題!?
我是用以下的程式碼!

1. Sub ex()
   
2. Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set sht = Sheets.Add(after:=Sheets(1))
   
5. Application.ScreenUpdating = False
   
6. With Sheet1
   
7.    For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
8.       mystr = A & "," & Left(A.Offset(, 1), 4)
   
9.       d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
   
10.    Next
    
11. End With
    
12. k = 1: r = 1
    
13. For Each ky In d.keys
    
14. y = Split(ky, ",")(1)
    
15. With Sheets(y)
    
16. Set C = .Columns("A").Find(d(ky))
    
17. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
18. If Not C Is Nothing And Not B Is Nothing Then
    
19. x = Application.Max(3, C.Row - 14)
    
20.    Set Rng = .Cells(x, 1).Resize(15, 1)
    
21.    Set Rng1 = .Cells(x, B.Column).Resize(15, 1)
    
22.    With sht
    
23.       Rng.Copy .Cells(r, k)
    
24.       Rng1.Copy .Cells(r, k + 1)
    
25.       .Cells(r, 3) = y & "年第" & B.Column - 1 & "筆"
    
26.    End With
    
27.    r = r + 15
    
28.    Else
    
29.    MsgBox "無此除權資料"
    
30. End If
    
31. End With
    
32. Next
    
33. Application.ScreenUpdating = True
    
34. End Sub

複製代碼

(因為資料檔案太大，所以我先刪除其他九年的資料，只剩2010)

謝謝您!^^

candy516

回復 23# Hsieh


謝謝前輩的解說!
前輩所寫的程式碼真的幫我很大的忙，
我現在可以自由的更改我想要抓取的欄位!
或者是特定哪一天的資料!
真的很感謝您!^^
謝謝!