返回列表 上一主題 發帖

[發問] 請問日價格怎麼轉變成週價格呢?

[發問] 請問日價格怎麼轉變成週價格呢?

不知道這能用公式解決嗎?還是要寫程式碼才能完成呢?

Book.rar (9.16 KB)

回復 1# jovi0801
試試看
  1. Sub Ex() 'DatePart("WW", .Rows(xi).Cells(1))  傳回第幾週
  2.     Dim Rng As Range, xi As Integer
  3.     With Sheets("日價格").Range("A1").CurrentRegion.Rows
  4.         Set Rng = .Rows(1)
  5.         xi = 2
  6.         Do
  7.             If DatePart("WW", .Rows(xi).Cells(1)) <> DatePart("WW", .Rows(xi + 1).Cells(1)) Then Set Rng = Union(Rng, .Rows(xi))
  8.             xi = xi + 1
  9.            If xi = .Rows.Count Then Set Rng = Union(Rng, .Rows(xi))
  10.         Loop While xi < .Rows.Count
  11.     End With
  12.     With Sheets("周價格")
  13.         .UsedRange.Clear
  14.         Rng.Copy .[a1]
  15.     End With
  16. End Sub
複製代碼

TOP

回復 2# GBKEE
感謝版主的解答,透過版主的程式碼,只要把"WW"變成"m"就會變成月價格囉!

TOP

回復 2# GBKEE


    不好意思,我仔細一看,這程式碼,是把每週五的開低收高秀出來,那我想把開盤價設在週一,最高最低是這在週所出現的數值,收盤當然週五最後的價格,我有看到對岸寫的程式碼,但我不知道要從而改起,請版主看看
Sub bwwweek()
‘建立新的工作表, 存放周数据
ActiveWorkbook.Sheets.Add after:=Worksheets(1)
Worksheets(1).Activate

‘把第一行数据存到变量,hand为行号,h为最高,l为最低,c为收盘,d为日期,vol为成交股数,amt为成交金额

Dim hand As Integer, h As Double, l As Double, _
c As Double, d As Date, o As Double, _
vol As Long, amt As Long
hand = 1
d = Worksheets(1).Cells(hand, 1).Value

‘交易第一天离开星期五有几天,n5计数器,fri储存星期五的日期
Dim n5 As Integer, md5 As Date
For n5 = 0 To 4
fri = d + n5
If Weekday(fri) – 1 = 5 Then
Exit For
End If
Next n5

‘第一周的行数,row1为本周第一交易日行数,row5为本周最后交易日行数, frim暂储存一周内交易日的数据, 用于和这周fri日期比较,大于fri即计算本周最后交易日行数
Dim row1 As Integer, row5 As Integer, frim As Date
row1 = 1

Dim n As Integer
For n = 1 To 6
If frim > fri Then
row5 = n – 1
Exit For
End If
frim = Worksheets(1).Cells((hand + n), 1).Value
Next n

‘把总共股票日K线原始数据的行数储存在rng变量
Dim rng As Integer
rng = Range(“A65536〃).End(xlUp).Row

Dim whand As Integer, wdate As Date
whand = 1
‘==========================================================
While row1 <= rng
‘——————————————————
If frim >= fri Or frim = 0 Then

‘把一周开盘,收盘,量等存入变量, 用于下面写入周的新工作表
wopen = Worksheets(1).Cells(row1, 2).Value
whigh = Application.WorksheetFunction.Max(Range(Cells(row1, 3), Cells(row5, 3)))
wlow = Application.WorksheetFunction.Min(Range(Cells(row1, 4), Cells(row5, 4)))
wclose = Worksheets(1).Cells(row5, 5).Value
wdate = Worksheets(1).Cells(row1, 1).Value

hand = row5 + 1

Worksheets(2).Cells(whand, 1).Value = wdate
Worksheets(2).Cells(whand, 2).Value = wopen
Worksheets(2).Cells(whand, 3).Value = whigh
Worksheets(2).Cells(whand, 4).Value = wlow
Worksheets(2).Cells(whand, 5).Value = wclose
whand = whand + 1

End If
‘————————————————————-
If hand <= rng And frim <> 0 Then

frim = Worksheets(1).Cells(hand, 1).Value
‘-  -  -  -  -  -  -
For n5 = 0 To 4
fri = frim + n5

If Weekday(fri) – 1 = 5 Then
Exit For
End If
Next n5
‘-  -  -  -  -  -  -

row1 = row5 + 1
‘///////////////////////////////////////////////////
For n = 1 To 6
If frim > fri Or frim = 0 Then
row5 = row5 + n – 1
Exit For
End If
frim = Worksheets(1).Cells((hand + n), 1).Value
Next n
‘//////////////////////////////////////////////////
Else
row1 = row5 + 1
End If
‘———————————————————–
Wend
‘===================================================
End Sub

TOP

本帖最後由 GBKEE 於 2012-7-10 16:02 編輯

回復 4# jovi0801
  1. Sub Ex() 'DatePart("WW", .Rows(xi).Cells(1))  傳回第幾週
  2.     Dim AR, xi As Integer, xAr As Integer, Rng As Range
  3.     With Sheets("日價格")
  4.         AR = Application.Transpose(.Range("A1").CurrentRegion.Rows(1).Value)         '取得欄位
  5.         xAr = 2
  6.         xi = 2
  7.         ReDim Preserve AR(1 To 5, 1 To xAr)                             '新增一維空白陣列
  8.         Set Rng = .Cells(xi, "A")                                       '一週營業的第一天日期位置
  9.         Do While .Cells(xi, "A") <> ""
  10.             If DatePart("WW", .Cells(xi, "A")) <> DatePart("WW", .Cells(xi + 1, "A")) Then
  11.                 Set Rng = Range(Rng, .Cells(xi, "E"))                   '一週營業的第一天日期位置  到  最後第一天收盤價位置
  12.                 AR(1, xAr) = Rng.Cells(1)                               '日期  Rng.Cells(1) 日期: 週一  或 .Cells(xi, "A") 日期: 週五(最後一天)
  13.                 AR(2, xAr) = Rng.Cells(1, 2)                            '開盤價
  14.                 AR(3, xAr) = Application.Max(Rng.Columns(3))            '最高價
  15.                 AR(4, xAr) = Application.Min(Rng.Columns(4))             '最低價
  16.                 AR(5, xAr) = .Cells(xi, "E")                            '收盤價
  17.                 If .Cells(xi + 1, "A") <> "" Then
  18.                     Set Rng = .Cells(xi + 1, "a")
  19.                     xAr = xAr + 1
  20.                     ReDim Preserve AR(1 To 5, 1 To xAr)
  21.                 End If
  22.             End If
  23.             xi = xi + 1
  24.         Loop
  25.     End With
  26.     With Sheets("周價格")
  27.         .UsedRange.Clear
  28.         .[A1].Resize(xAr, 5) = Application.Transpose(AR)
  29.     End With
  30. End Sub
複製代碼

TOP

回復 4# jovi0801
如果這是交易紀錄,不應該判斷周一與周五為區間
因為有可能遇到假日休市,以周別判定不知是否比較正確?
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. With Sheet1
  5. d1(1) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[d1].Value, .[E1].Value)
  6. For Each a In .Range(.[A2], .[A2].End(xlDown))
  7. w = Year(a) & ":" & Application.WorksheetFunction.WeekNum(a)
  8. If IsEmpty(d(w & "開")) Then d(w & "開") = a.Offset(, 1).Value
  9. If a.Offset(, 2) > d(w & "高") Then d(w & "高") = a.Offset(, 2).Value
  10. If IsEmpty(d(w & "低")) Then
  11. d(w & "低") = a.Offset(, 3).Value
  12. ElseIf d(w & "低") > a.Offset(, 3) Then
  13. d(w & "低") = a.Offset(, 3).Value
  14. End If
  15. d(w & "收") = a.Offset(, 4).Value
  16. d1(w) = Array(a.Value, d(w & "開"), d(w & "高"), d(w & "低"), d(w & "收"))
  17. Next
  18. End With
  19. With Sheet2
  20. .Cells = ""
  21. .[A1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))
  22. End With
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 5# GBKEE
再次感謝GBKEE版主的協助,解決我的問題

TOP

回復 6# Hsieh
謝謝Hsieh超級版主的提醒,但套用您的程式碼,會出現物件不支援此屬性或方法的訊息,而GBKEE版主所寫的程式碼,好像能達到您所說的效果,如附件 Book.rar (10.13 KB)

TOP

回復 5# GBKEE
回復 8# jovi0801
我加上了一欄 "期間" (scope) 如此可以清楚地看出它們的歸屬。
純參考,希望 GBKEE 大大莫介意。
  1. Sub Ex()                           ' DatePart("WW", .Rows(xi).Cells(1))  傳回第幾週
  2.     Dim AR, xi As Integer, xAr As Integer, Rng As Range, scope As String
  3.    
  4.     With Sheets("日價格")
  5.         AR = Application.Transpose(.Range("A1").CurrentRegion.Rows(1).Value)     ' 取得欄位
  6.         xAr = 2
  7.         xi = 2
  8.         ReDim Preserve AR(1 To 6, 1 To xAr)                      ' 新增一維空白陣列
  9.         
  10.         Set Rng = .Cells(xi, "A")                                ' 一週營業的第一天日期位置
  11.         scope = .Cells(xi, "A")
  12.         
  13.         Do While .Cells(xi, "A") <> ""
  14.             If DatePart("WW", .Cells(xi, "A")) <> DatePart("WW", .Cells(xi + 1, "A")) Then
  15.                 Set Rng = Range(Rng, .Cells(xi, "E"))            ' 一週營業的第一天日期位置  到  最後第一天收盤價位置
  16.                 AR(1, xAr) = Rng.Cells(1)           ' 日期  Rng.Cells(1) 日期: 週一  或 .Cells(xi, "A") 日期: 週五(最後一天)
  17.                 AR(2, xAr) = Rng.Cells(1, 2)                     ' 開盤價
  18.                 AR(3, xAr) = Application.Max(Rng.Columns(3))     ' 最高價
  19.                 AR(4, xAr) = Application.Min(Rng.Columns(4))     ' 最低價
  20.                 AR(5, xAr) = .Cells(xi, "E")                     ' 收盤價
  21.                 AR(6, xAr) = scope & "-" & .Cells(xi, "A")
  22.                
  23.                 If .Cells(xi + 1, "A") <> "" Then
  24.                     Set Rng = .Cells(xi + 1, "A")
  25.                     xAr = xAr + 1
  26.                     scope = .Cells(xi + 1, "A")
  27.                     ReDim Preserve AR(1 To 6, 1 To xAr)
  28.                 End If
  29.             End If
  30.             xi = xi + 1
  31.         Loop
  32.     End With
  33.    
  34.     With Sheets("周價格")
  35.         .UsedRange.Clear
  36.         .[A1].Resize(xAr, 6) = Application.Transpose(AR)
  37.     End With
  38. End Sub
複製代碼
日價格怎麼轉變成週價格.rar (9.85 KB)

TOP

回復 9# c_c_lai
加上期間這不錯啊 ,但可不需新增變數來顯示.   
AR(6, xAr) = scope & "-" & .Cells(xi, "A")   ->      AR(6, xAr) = Rng.Cells(1) & "-" & .Cells(xi, "A")

TOP

        靜思自在 : 話多不如話少,話少不如話好。
返回列表 上一主題