[發問] 求助~關於vba的程式!

candy516

各位你們好~
    我是VBA的超級新手，因為是念商科的，對VBA完全沒概念!
研究VBA好幾天後，真的還是沒辦法寫出什麼東西來!
    不知道有沒有大大可以幫我起各頭，或是提點我一下，我真得是太笨了!= =:'(
我是要做填權息的研究，附檔中有MARK黃底的代表除(權)息日，我要去驗證，(從第二個SHEET開始)
在除權息當天的收盤價是否會大於除權息前一日的收盤價，如果有即表示有填權息現象，
如妥在除權息當日沒有填權息則繼續往上找，看到第幾天時會填權息。
    請問有沒有先進可以提示我一下，小妹我真的是想破了頭還是想不太出來!= =
拜託了各位~
^^:loveliness:

candy516

回復 23# Hsieh
謝謝你的幫忙!
我目前是分兩個程式執行：
第一：先將所有股價的欄位都刪除
Sub delcol()
Dim i%, c As Range
Set c = Columns(2)
For i = 4 To [iv1].End(1).Column Step 2
Set c = Union(c, Columns(i))
Next
c.Delete
End Sub
第二：再將空格刪除，把資料往上補，在後再將其結果轉置。
Sub ex1()
Columns("B:CF").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub
因為我後來想說，我先不要設定所謂有完成填權的天數，
這樣彈性比較大!而我到時候想看"幾天"完成填權的公司，
再用EXCEL篩選功能即可!
真的很謝謝你耐心的幫忙!
^^

Hsieh

回復 22# candy516
這樣可能麻煩一點
程式將填入填權日數，並將10日內填權名單列出
請將程式碼置於Sheet1模組

1. Sub 填權()
   
2. Dim A As Range, Ar()
   
3. Set dic = CreateObject("Scripting.Dictionary")
   
4. Set myday = CreateObject("Scripting.Dictionary")
   
5.           ReDim Preserve Ar(z)
   
6.           Ar(z) = Array("公司", "年度", "填權日數")
   
7.           z = z + 1
   
8. 
   
9. Dim Sh As Worksheet
   
10. For j = Sheets.Count To 1 Step -1
    
11. Set Sh = Sheets(j)
    
12.   With Sh
    
13.      If .Name <> Me.Name Then
    
14.      Set rng = .Range(.[B1], .Cells(1, .Columns.Count).End(xlToLeft))
    
15.         If Application.CountBlank(rng) > 0 Then rng.SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
    
16.         For r = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
    
17.         Set A = .Cells(r, 1)
    
18.            myday(A.Value) = temp
    
19.            temp = A.Value
    
20.         Next
    
21.         Else
    
22.         For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(3))
    
23.         dic(A & Year(A.Offset(, 1))) = A.Offset(, 1)
    
24.         Next
    
25.     End If
    
26.   End With
    
27. Next
    
28. For Each Sh In Sheets
    
29.   With Sh
    
30.   If .Name < Me.Name Then
    
31.   k = 2: dn = .Name
    
32.     Do Until .Cells(1, k) = ""
    
33.        .Columns(k + 1).Insert
    
34.        f = .Cells(1, k)
    
35.        Set A = .Columns("A").Find(dic(f & dn))
    
36.        If A Is Nothing Then GoTo 20
    
37.        d = myday(A.Value)
    
38.        With Sheets(CStr(Year(d)))
    
39.           Set b = .Columns("A").Find(d)
    
40.           Set c = .Rows(1).Find(f)
    
41.           If b Is Nothing Or c Is Nothing Then cnt = "無填權": GoTo 10
    
42.           x = b.Row
    
43.           y = c.Column
    
44.           test = .Cells(x, y)
    
45.        End With
    
46.        r = A.Row: cnt = 1
    
47.        Do Until r = 2 Or .Cells(r, k) >= test
    
48.        r = r - 1
    
49.        cnt = cnt + 1
    
50.        Loop
    
51.        If r = 2 Then cnt = "無填權"
    
52. 10
    
53.        .Cells(A.Row, k + 1) = cnt
    
54.        If IsNumeric(cnt) And cnt <= 10 Then
    
55.           ReDim Preserve Ar(z)
    
56.           Ar(z) = Array(f, dn, cnt)
    
57.           z = z + 1
    
58.        End If
    
59.       
    
60. 20
    
61.        k = k + 2
    
62.     Loop
    
63.   End If
    
64.   End With
    
65. Next
    
66. Set dic = Nothing
    
67. Set myday = Nothing
    
68. With Worksheets.Add
    
69. .[A1].Resize(z, 3) = Application.Transpose(Application.Transpose(Ar))
    
70. .Move
    
71. End With
    
72. End Sub

複製代碼

candy516

回復 20# Hsieh


你好~
但是每個年度有除權的公司不太一樣~
所以要把它合併到同一張工作表中似乎有一點困難!
謝謝!

FAlonso

自己做了一個,給其他會員看看,excel文件稍為做了一些修改,把空column給刪掉
不能下載的話,請看下列程式

1. Sub chooseyellowcell2()
   
2. Dim i As Integer, myfinalrow As Integer
   
3. Dim mycell As Range, mycolumn As Range, mycell2 As Range, mytarget As Range, mybaseline As Range, mycheck As Range
   
4. Dim checkstatus As Boolean
   
5. 
   
6. ThisWorkbook.Activate
   
7. 
   
8. For i = 2 To Worksheets.Count
   
9.     Sheets(i).Activate
   
10.     myfinalrow = ActiveSheet.Range("A2").End(xlDown).Offset(1).Row
    
11.         For Each mycell In ActiveSheet.Range("A1", Range("IV1").End(xlToLeft))
    
12.             If mycell.Value <> "" Then
    
13.             Set mycolumn = Range(mycell, mycell.End(xlDown))
    
14.                 For Each mycell2 In mycolumn
    
15.                     If mycell2.Interior.ColorIndex = 6 Then
    
16.                         checkstatus = False
    
17.                         Set mybaseline = mycell2.Offset(1)
    
18.                         Set mycheck = mycell2
    
19.                             If mybaseline.Value = "" Then
    
20.                             mybaseline.Value = "無法計算"
    
21.                             Exit For
    
22.                             Else
    
23.                             Do
    
24.                                 If mycheck.Value >= mybaseline.Value Then
    
25.                                 ActiveSheet.Cells(myfinalrow, mycheck.Column) = mybaseline.Row - mycheck.Row
    
26.                                 checkstatus = True
    
27.                                 Exit Do
    
28.                                 Else
    
29.                                 Set mycheck = mycheck.Offset(-1)
    
30.                                 End If
    
31.                             Loop While checkstatus = False And IsNumeric(mycheck) = True
    
32.                                 If checkstatus = False Then
    
33.                                 mycheck.End(xlDown).Offset(1).Value = "無填權"
    
34.                                 End If
    
35.                             End If
    
36.                     End If
    
37.                 Next
    
38.             End If
    
39.         Next
    
40. Next
    
41. 
    
42. End Sub

複製代碼

計算除權日.rar (289.3 KB)

下載次數: 3

2011-1-19 14:29

Hsieh

回復 19# candy516
比較好的方式是把所有年度資料都整理在同一工作表中
跨年跨月的問題就容易解決

candy516

回復 18# FAlonso


你好~
我都沒發現到這個問題耶!
日勝生在2003/01/02除權，其實它應該要跟2002/12/31的收盤價做比較!
因為我是分年度抓資料的,所以忽略了這一點!= =
日數都是交易日沒錯!
^^

FAlonso

不好意思,我發現一些問題
2003年Z行股票"日勝生",黃色格子是最後一行
根據你的說法,計算日子的方法是把黃色格子及黃色格子位置以上的格子* 和 黃色格子以下的一格作比較
現在黃色格子下面沒有東西,怎辦?

*指若黃色格子是C10,所謂以上的格子是C9,C8,........云云,黃色以下的一格代表C11云云

還有中間的日數是否指trading days?

candy516

看起來儲存格格式是一樣，我已經把資料重抓一便!
重抓就OK了!
^^
謝謝!

Hsieh

回復 15# candy516

那要看你的格式是否跟其他年度一樣