123
返回列表 上一主題 發帖

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

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
245  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-11 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2011-1-17 18:06 | 只看該作者
回復 10# candy516
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Application.ScreenUpdating = False
  4. With Sheet1
  5.    For Each a In .Range(.[A2], .[A2].End(xlDown))
  6.       d(a & Year(a.Offset(, 1))) = a.Offset(, 1).Value
  7.    Next
  8. End With
  9. For y = 2001 To 2010
  10.   With Sheets(CStr(y))
  11.     If Application.CountBlank(.Range(.[B1], .[IV1].End(xlToLeft))) > 0 Then .Range(.[B1], .[IV1].End(xlToLeft)).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
  12.     .Range(.[IV1].End(xlToLeft).Offset(, 1), .[IV1]).EntireColumn.Clear
  13.     k = 2
  14.     Do Until .Cells(1, k) = ""
  15.     .Columns(k + 1).Insert
  16.        mystr = .Cells(1, k) & y
  17.        Set a = .Columns("A").Find(d(mystr))
  18.        If Not a Is Nothing Then
  19.        cnt = 0
  20.          r = a.Row
  21.          test = .Cells(r + 1, k)
  22.          cnt = cnt + 1
  23.          Do Until .Cells(r, k) >= test Or .Cells(r, k) = ""
  24.          cnt = cnt + 1
  25.          r = r - 1
  26.          Loop
  27.          If r <= 2 Then
  28.          .Cells(a.Row, k + 1) = "無填權"
  29.          Else
  30.          .Cells(a.Row, k + 1) = cnt
  31.          End If
  32.        End If
  33.        k = k + 2
  34.     Loop
  35.   End With
  36. Next
  37. Application.ScreenUpdating = True
  38. End Sub
複製代碼
學海無涯_不恥下問

TOP

candy516

帖子
47 
主題
5 
精華
0 
積分
116 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2011-1-14 
最後登錄
2012-3-10 
12#
發表於 2011-1-17 18:22 | 只看該作者
回復 11# Hsieh


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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
245  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-11 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
13#
發表於 2011-1-17 18:41 | 只看該作者
回復 12# candy516

因為欄數過多必須使用2007版本
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Application.ScreenUpdating = False
  4. With Sheet1
  5.    For Each a In .Range(.[A2], .[A2].End(xlDown))
  6.       d(a & Year(a.Offset(, 1))) = a.Offset(, 1).Value
  7.    Next
  8. End With
  9. For y = 2001 To 2004
  10.   With Sheets(CStr(y))
  11.     If Application.CountBlank(.Range(.[B1], .[XFD1].End(xlToLeft))) > 0 Then .Range(.[B1], .[XFD1].End(xlToLeft)).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
  12.     .Range(.[XFD1].End(xlToLeft).Offset(, 1), .[XFD1]).EntireColumn.Clear
  13.     k = 2
  14.     Do Until .Cells(1, k) = ""
  15.     .Columns(k + 1).Insert
  16.        mystr = .Cells(1, k) & y
  17.        Set a = .Columns("A").Find(d(mystr))
  18.        If Not a Is Nothing Then
  19.        cnt = 0
  20.          r = a.Row
  21.          test = .Cells(r + 1, k)
  22.          cnt = cnt + 1
  23.          Do Until .Cells(r, k) >= test Or .Cells(r, k) = ""
  24.          cnt = cnt + 1
  25.          r = r - 1
  26.          Loop
  27.          If r <= 2 Then
  28.          .Cells(a.Row, k + 1) = "無填權"
  29.          Else
  30.          .Cells(a.Row, k + 1) = cnt
  31.          End If
  32.        End If
  33.        k = k + 2
  34.     Loop
  35.   End With
  36. Next
  37. Application.ScreenUpdating = True
  38. End Sub
複製代碼
學海無涯_不恥下問

TOP

candy516

帖子
47 
主題
5 
精華
0 
積分
116 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2011-1-14 
最後登錄
2012-3-10 
14#
發表於 2011-1-17 18:53 | 只看該作者
對齁~欄位數有差!
我懂了!但我現在發現我資料有一點搞錯了!= =
我再去重抓資料了!
謝謝你的耐心回覆!
又問題可以再請教你嗎?^^
謝謝你!

TOP

candy516

帖子
47 
主題
5 
精華
0 
積分
116 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2011-1-14 
最後登錄
2012-3-10 
15#
發表於 2011-1-17 21:33 | 只看該作者
回復 13# Hsieh


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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
245  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-11 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
16#
發表於 2011-1-17 21:58 | 只看該作者
回復 15# candy516

那要看你的格式是否跟其他年度一樣
學海無涯_不恥下問

TOP

candy516

帖子
47 
主題
5 
精華
0 
積分
116 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2011-1-14 
最後登錄
2012-3-10 
17#
發表於 2011-1-18 00:01 | 只看該作者
看起來儲存格格式是一樣，我已經把資料重抓一便!
重抓就OK了!
^^
謝謝!

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
18#
發表於 2011-1-18 20:33 | 只看該作者
本帖最後由 FAlonso 於 2011-1-18 20:45 編輯

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

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

還有中間的日數是否指trading days?
80 字節以內
不支持自定義 Discuz! 代碼

TOP

candy516

帖子
47 
主題
5 
精華
0 
積分
116 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2011-1-14 
最後登錄
2012-3-10 
19#
發表於 2011-1-18 23:28 | 只看該作者
回復 18# FAlonso


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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
245  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-11 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
20#
發表於 2011-1-19 13:26 | 只看該作者
回復 19# candy516
比較好的方式是把所有年度資料都整理在同一工作表中
跨年跨月的問題就容易解決
學海無涯_不恥下問

TOP

        靜思自在 : 成功是優點的發揮，失敗是缺點的累積。
123
返回列表 上一主題