返回列表 上一主題 發帖

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

FAlonso

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

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

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

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

TOP

FAlonso

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

自己做了一個,給其他會員看看,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

  6. ThisWorkbook.Activate

  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

  42. End Sub
複製代碼
計算除權日.rar (289.3 KB)
80 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 君子立恆志，小人恆立志。
返回列表 上一主題