Hsieh

回復 20# candy516

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 & "," & A.Offset(, 1)
   
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 = Left(Split(ky, ",")(1), 4)
    
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 - 5)
    
20.    Set Rng = .Cells(x, 1).Resize(5, 1)
    
21.    Set Rng1 = .Cells(x, B.Column).Resize(5, 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 + 5
    
28.    Else
    
29.    MsgBox "無此除權資料"
    
30. End If
    
31. End With
    
32. Next
    
33. Application.ScreenUpdating = True
    
34. End Sub

複製代碼

candy516

回復 21# Hsieh


前輩您好：
我研究了這次得程式碼和之前的程式碼有何不同，發現不同之處在於
mystr = A & "," & A.Offset(, 1)d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
Next
End With
k = 1: r = 1
For Each ky In d.keys
y = Left(Split(ky, ",")(1), 4)
With Sheets(y)
請問Left(A.Offset(, 1), 4)有什麼差別呢?
再請問如果我只想要顯示事件日後第五天的報酬我應該怎麼改呢?
(舉例來說，事件日是20041119，則我要20041123的資料(t+4))
我試了好久還是不成功耶!= =
非常感謝!^^

Hsieh

回復 22# candy516


    可能有2種情況吧

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 & "," & A.Offset(, 1)
   
9.       d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
   
10.       '若是直接用事件後第4天做搜尋值
    
11.       'd(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00")) + 4
    
12.    Next
    
13. End With
    
14. k = 1: r = 1
    
15. For Each ky In d.keys
    
16. y = Left(Split(ky, ",")(1), 4)
    
17. With Sheets(y)
    
18. Set C = .Columns("A").Find(d(ky))
    
19. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
20. If Not C Is Nothing And Not B Is Nothing Then
    
21. x = Application.Max(3, C.Row - 5)
    
22.    '用事件日向上4格為目標
    
23.    Set Rng = .Cells(x, 1)
    
24.    Set Rng1 = .Cells(x, B.Column)
    
25.    '直接用事件後第4天做搜尋值
    
26.    'Set Rng = .Cells(C.Row, 1)
    
27.    'Set Rng1 = .Cells(C.Row, B.Column)
    
28. 
    
29.    With sht
    
30.       Rng.Copy .Cells(r, k)
    
31.       Rng1.Copy .Cells(r, k + 1)
    
32.       .Cells(r, 3) = y & "年第" & B.Column - 1 & "筆"
    
33.    End With
    
34.    r = r + 1 '只有一天資料所以只要加1
    
35.    Else
    
36.    MsgBox "無" & y & "年" & Split(ky, ",")(0) & "事件資料"
    
37. End If
    
38. End With
    
39. Next
    
40. Application.ScreenUpdating = True
    
41. End Sub

複製代碼

candy516

回復 23# Hsieh


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

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)

謝謝您!^^

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

回復 26# Hsieh


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

candy516

回復 26# Hsieh


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

Hsieh

回復 28# candy516

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

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

candy516

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