麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 求助~關於vba的程式! [打印本頁]

作者: candy516 時間: 2011-1-14 00:49 標題: 求助~關於vba的程式!

本帖最後由 candy516 於 2011-1-17 18:26 編輯

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

作者: hugh0620 時間: 2011-1-14 09:20

本帖最後由 hugh0620 於 2011-1-14 09:25 編輯

回復 1# candy516

xx~ 想一下~ 看看能不能幫妳~ 因為我也是新手

作者: candy516 時間: 2011-1-14 16:30

謝謝您~我也持續的在研究中!^^

作者: candy516 時間: 2011-1-16 16:11

你好~
已經改成2003版的檔案了!
謝謝你!
^^

作者: Hsieh 時間: 2011-1-16 22:40

回復 4# candy516
最主要是看不懂你所謂除權息的標是要填在哪裡?
請試舉例來說明，你資料要怎麼填法

作者: candy516 時間: 2011-1-16 23:40

本帖最後由 candy516 於 2011-1-16 23:44 編輯

舉例來說：像是2010年1225 福懋油的除權日是9/7(黃底)，所以我去比較1225 福懋油9/7的收盤價是否大於等於9/8，如果沒有，就繼續找，9/6的收盤價是否大於等於9/8的收盤價，直到找到為止!最後得到需要幾天的時間，可以完成填權(某日的收盤價大於等於除權日(9/8))。最後新增一欄，將結果顯示在除權日(黃底旁)!
:)

作者: Hsieh 時間: 2011-1-17 10:32

本帖最後由 Hsieh 於 2011-1-17 16:20 編輯

回復 6# candy516

我不懂的是，Sheet1記載是2010/9/7 是除權日
但妳敘述時又是變成2010/9/8
若條件沒成立是往前找或是往後找
找到後要在C85寫入什麼值?
萬一除權後都沒回升又該如何?

作者: candy516 時間: 2011-1-17 16:08

Hsieh 大大你好：
Sheet1原始資料，像是SGEET1的A2的福懋油，他的除權日2010/9/7，我就先把SHEET2的B85用黃底標示出來，我要計算的是SHEET2的B85(9/7)是否大於等於B86(9/6)(填權的意思是說：除權當日的收盤價是否大於等於除權日前一日的收盤價)，如果以這個例子來說，除權日當天則已經填權，就不要再繼續找9/8，但如果9/7沒有大於9/6，則必須再去看9/8是否大於等於9/6，C85這個儲存格我是想顯示出；需要幾天的時間可以完成填權。(像是福懋油則顯示1，因為他當天即完成填權)
不知道大大懂不懂我的意思，真的是很不好意思，想請教你還把檔案搞得你看不懂!

謝謝你的幫忙!^^

作者: Hsieh 時間: 2011-1-17 16:19

回復 8# candy516

Sub ex()
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheet1
For Each a In .Range(.[A2], .[A2].End(xlDown))
d(a & Year(a.Offset(, 1))) = Array(a.Offset(, 1), a.Offset(, 2))
Next
End With
For y = 2001 To 2010
With Sheets(CStr(y))
If Application.CountBlank(.Range(.[B1], .[IV1].End(xlToLeft))) > 0 Then .Range(.[B1], .[IV1].End(xlToLeft)).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
.Range(.[IV1].End(xlToLeft).Offset(, 1), .[IV1]).EntireColumn.Clear
k = 2
Do Until .Cells(1, k) = ""
.Columns(k + 1).Insert
mystr = .Cells(1, k) & y
Set a = .Columns("A").Find(d(mystr)(0))
If Not a Is Nothing Then
cnt = 0
r = a.Row
test = .Cells(r - 1, k)
r = r + 1
cnt = cnt + 1
Do Until .Cells(r, k) >= test Or .Cells(r, k) = ""
cnt = cnt + 1
r = r + 1
Loop
If .Cells(r, 1) = "" Then
.Cells(a.Row, k + 1) = "無填權"
Else
.Cells(a.Row, k + 1) = cnt
End If
End If
k = k + 2
Loop
End With
Next
Application.ScreenUpdating = True
End Sub

複製代碼

作者: candy516 時間: 2011-1-17 16:37

Hsieh大大你好~
哇，你真的好厲害唷!我才把尋找儲存格底色的方法研究出來，你就寫出來了!真是太感謝了!
不過我的解釋好像還是不夠清楚= = !我再說清楚一點：
像是福懋要他是9/7日除權，所以第一步驟就是用9/7的收盤價和9/6的比(14.3>14.26)，所以在C85填上1(天)!
再來是1235興泰，他的除權日是9/13，所以我先用9/13和9/10
(9/13的收盤價46.1<9/10的收盤價46.89)，所以再繼續比
(9/14的收盤價46.3<9/10的收盤價46.89)，所以要再繼續比
(9/15的收盤價48.75>9/10的收盤價46.89)，
在這一天則找到完成填權的!所以就再D81填上"3"(天)
不知道大大這樣了解我的意思嗎?真的不好意思，表達能力不是很好!
真心的謝謝你!^^

作者: Hsieh 時間: 2011-1-17 18:06

回復 10# candy516

Sub ex()
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheet1
For Each a In .Range(.[A2], .[A2].End(xlDown))
d(a & Year(a.Offset(, 1))) = a.Offset(, 1).Value
Next
End With
For y = 2001 To 2010
With Sheets(CStr(y))
If Application.CountBlank(.Range(.[B1], .[IV1].End(xlToLeft))) > 0 Then .Range(.[B1], .[IV1].End(xlToLeft)).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
.Range(.[IV1].End(xlToLeft).Offset(, 1), .[IV1]).EntireColumn.Clear
k = 2
Do Until .Cells(1, k) = ""
.Columns(k + 1).Insert
mystr = .Cells(1, k) & y
Set a = .Columns("A").Find(d(mystr))
If Not a Is Nothing Then
cnt = 0
r = a.Row
test = .Cells(r + 1, k)
cnt = cnt + 1
Do Until .Cells(r, k) >= test Or .Cells(r, k) = ""
cnt = cnt + 1
r = r - 1
Loop
If r <= 2 Then
.Cells(a.Row, k + 1) = "無填權"
Else
.Cells(a.Row, k + 1) = cnt
End If
End If
k = k + 2
Loop
End With
Next
Application.ScreenUpdating = True
End Sub

複製代碼

作者: candy516 時間: 2011-1-17 18:22

回復 11# Hsieh

請問大大~
如果我將程式碼COPY的另外一個檔案(現金股利的)，有哪裡是需要改的嗎?
因為好像無法套用，我有上傳一個新的檔案是現金股利的，但因為檔案太大，
所以我先將部分資料刪掉，只從2005~2010!
謝謝你的幫忙!

作者: Hsieh 時間: 2011-1-17 18:41

回復 12# candy516

因為欄數過多必須使用2007版本

Sub ex()
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheet1
For Each a In .Range(.[A2], .[A2].End(xlDown))
d(a & Year(a.Offset(, 1))) = a.Offset(, 1).Value
Next
End With
For y = 2001 To 2004
With Sheets(CStr(y))
If Application.CountBlank(.Range(.[B1], .[XFD1].End(xlToLeft))) > 0 Then .Range(.[B1], .[XFD1].End(xlToLeft)).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
.Range(.[XFD1].End(xlToLeft).Offset(, 1), .[XFD1]).EntireColumn.Clear
k = 2
Do Until .Cells(1, k) = ""
.Columns(k + 1).Insert
mystr = .Cells(1, k) & y
Set a = .Columns("A").Find(d(mystr))
If Not a Is Nothing Then
cnt = 0
r = a.Row
test = .Cells(r + 1, k)
cnt = cnt + 1
Do Until .Cells(r, k) >= test Or .Cells(r, k) = ""
cnt = cnt + 1
r = r - 1
Loop
If r <= 2 Then
.Cells(a.Row, k + 1) = "無填權"
Else
.Cells(a.Row, k + 1) = cnt
End If
End If
k = k + 2
Loop
End With
Next
Application.ScreenUpdating = True
End Sub

複製代碼

作者: candy516 時間: 2011-1-17 18:53

對齁~欄位數有差!
我懂了!但我現在發現我資料有一點搞錯了!= =
我再去重抓資料了!
謝謝你的耐心回覆!
又問題可以再請教你嗎?^^
謝謝你!

作者: candy516 時間: 2011-1-17 21:33

回復 13# Hsieh

請問~
為什麼在執行後只有2008年的格式會跑掉呢?!
謝謝你!

作者: Hsieh 時間: 2011-1-17 21:58

回復 15# candy516

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

作者: candy516 時間: 2011-1-18 00:01

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

作者: FAlonso 時間: 2011-1-18 20:33

本帖最後由 FAlonso 於 2011-1-18 20:45 編輯

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

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

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

作者: candy516 時間: 2011-1-18 23:28

回復 18# FAlonso

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

作者: Hsieh 時間: 2011-1-19 13:26

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

作者: FAlonso 時間: 2011-1-19 14:31

本帖最後由 FAlonso 於 2011-1-19 14:33 編輯

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

Sub chooseyellowcell2()
Dim i As Integer, myfinalrow As Integer
Dim mycell As Range, mycolumn As Range, mycell2 As Range, mytarget As Range, mybaseline As Range, mycheck As Range
Dim checkstatus As Boolean
ThisWorkbook.Activate
For i = 2 To Worksheets.Count
Sheets(i).Activate
myfinalrow = ActiveSheet.Range("A2").End(xlDown).Offset(1).Row
For Each mycell In ActiveSheet.Range("A1", Range("IV1").End(xlToLeft))
If mycell.Value <> "" Then
Set mycolumn = Range(mycell, mycell.End(xlDown))
For Each mycell2 In mycolumn
If mycell2.Interior.ColorIndex = 6 Then
checkstatus = False
Set mybaseline = mycell2.Offset(1)
Set mycheck = mycell2
If mybaseline.Value = "" Then
mybaseline.Value = "無法計算"
Exit For
Else
Do
If mycheck.Value >= mybaseline.Value Then
ActiveSheet.Cells(myfinalrow, mycheck.Column) = mybaseline.Row - mycheck.Row
checkstatus = True
Exit Do
Else
Set mycheck = mycheck.Offset(-1)
End If
Loop While checkstatus = False And IsNumeric(mycheck) = True
If checkstatus = False Then
mycheck.End(xlDown).Offset(1).Value = "無填權"
End If
End If
End If
Next
End If
Next
Next
End Sub

複製代碼

[attach]4453[/attach]

作者: candy516 時間: 2011-1-19 15:44

回復 20# Hsieh

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

作者: Hsieh 時間: 2011-1-20 13:36

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

Sub 填權()
Dim A As Range, Ar()
Set dic = CreateObject("Scripting.Dictionary")
Set myday = CreateObject("Scripting.Dictionary")
ReDim Preserve Ar(z)
Ar(z) = Array("公司", "年度", "填權日數")
z = z + 1
Dim Sh As Worksheet
For j = Sheets.Count To 1 Step -1
Set Sh = Sheets(j)
With Sh
If .Name <> Me.Name Then
Set rng = .Range(.[B1], .Cells(1, .Columns.Count).End(xlToLeft))
If Application.CountBlank(rng) > 0 Then rng.SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
For r = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
Set A = .Cells(r, 1)
myday(A.Value) = temp
temp = A.Value
Next
Else
For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(3))
dic(A & Year(A.Offset(, 1))) = A.Offset(, 1)
Next
End If
End With
Next
For Each Sh In Sheets
With Sh
If .Name < Me.Name Then
k = 2: dn = .Name
Do Until .Cells(1, k) = ""
.Columns(k + 1).Insert
f = .Cells(1, k)
Set A = .Columns("A").Find(dic(f & dn))
If A Is Nothing Then GoTo 20
d = myday(A.Value)
With Sheets(CStr(Year(d)))
Set b = .Columns("A").Find(d)
Set c = .Rows(1).Find(f)
If b Is Nothing Or c Is Nothing Then cnt = "無填權": GoTo 10
x = b.Row
y = c.Column
test = .Cells(x, y)
End With
r = A.Row: cnt = 1
Do Until r = 2 Or .Cells(r, k) >= test
r = r - 1
cnt = cnt + 1
Loop
If r = 2 Then cnt = "無填權"
10
.Cells(A.Row, k + 1) = cnt
If IsNumeric(cnt) And cnt <= 10 Then
ReDim Preserve Ar(z)
Ar(z) = Array(f, dn, cnt)
z = z + 1
End If
20
k = k + 2
Loop
End If
End With
Next
Set dic = Nothing
Set myday = Nothing
With Worksheets.Add
.[A1].Resize(z, 3) = Application.Transpose(Application.Transpose(Ar))
.Move
End With
End Sub

複製代碼

作者: candy516 時間: 2011-1-21 00:10

回復 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篩選功能即可!
真的很謝謝你耐心的幫忙!
^^

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)