Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12630 / 13645 ツリー ←次へ | 前へ→

【9475】グラフの重ね合わせ(2) NH 03/12/4(木) 19:53 質問
【9483】Re:グラフの重ね合わせ(2) Kein 03/12/5(金) 1:37 回答
【9509】Re:グラフの重ね合わせ(2) NH 03/12/5(金) 19:20 質問
【9510】Re:グラフの重ね合わせ(2) Kein 03/12/5(金) 20:37 回答
【9511】Re:グラフの重ね合わせ(2) NH 03/12/5(金) 20:54 発言
【9516】Re:グラフの重ね合わせ(2) Kein 03/12/6(土) 0:04 回答
【9521】Re:グラフの重ね合わせ(2) NH 03/12/6(土) 9:54 お礼

【9475】グラフの重ね合わせ(2)
質問  NH  - 03/12/4(木) 19:53 -

引用なし
パスワード
   11月20日に【9185】でグラフの重ね合わせについて質問させて
いただきました。その時は重ねあわせをしなくても近似値の機能
を使えば出来るということを教えていただいたんですが、それが
出来たらそしたらこれは出来ないかと欲が出てきまして、もう一回
伺います。同じ時系列で0%〜100%まで動くデータを株価グラフに
重ねあわせることは出来ないでしょうか。

サンプルの%kを株価グラフの下にのせたいんですけど。

日付       始値    高値    安値    終値    %K
2003/11/19    1545    1549    1480    1523    0.00
2003/11/20    1503    1558    1484    1536    7.78
2003/11/21    1530    1590    1529    1541    10.78
2003/11/25    1640    1671    1600    1600    55.80
2003/11/26    1648    1695    1645    1671    100.00
2003/11/27    1665    1688    1663    1679    100.00
2003/11/28    1699    1719    1685    1699    100.00
2003/12/1     1700    1742    1649    1730    100.00
2003/12/2         1731    1794    1712    1734    100.00
2003/12/3         1740    1741    1653    1665    67.30

【9483】Re:グラフの重ね合わせ(2)
回答  Kein  - 03/12/5(金) 1:37 -

引用なし
パスワード
   Sheet1のA〜E列をプロット範囲にした、株価ローソク足・終値移動平均2本のグラフ
を作り、そこへ新しい系列としてF列を棒グラフで追加するとします。
最初に出てくるフォームに、グラフタイトルを入力して下さい。

Sub MyChart_StockData()
  Dim ChTxt As String
  Dim MyR As Range
  Dim MinV As Long, Bet As Long
  Dim Ns As Series
 
  ChTxt = InputBox("グラフタイトルを入力して下さい")
  If ChTxt = "" Then Exit Sub
  Set MyR = Sheets("Sheet1").Range("A1").CurrentRegion
  Application.ScreenUpdating = False
  Charts.Add
  With ActiveChart
   .SetSourceData Source:= _
   Range(MyR.Columns(1), MyR.Columns(5)), _
   PlotBy:=xlColumns
   .ChartType = xlStockOHLC
   .Location Where:=xlLocationAsNewSheet
   .HasLegend = False
   With .ChartGroups(1)
     .HasUpDownBars = True
     .DownBars.Interior.ColorIndex = 5
     .DownBars.Border.ColorIndex = 5
     .UpBars.Interior.ColorIndex = 6
     .UpBars.Border.ColorIndex = 6
   End With
   .Axes(xlCategory).CategoryType = xlCategoryScale
   MinV = Int(WorksheetFunction.Min(.SeriesCollection(3).Values))
   With .Axes(xlValue)
     Bet = Int(.MajorUnit)
     .MinimumScale = WorksheetFunction.Floor(MinV, Bet)
   End With
   If MyR.Columns.Count = 6 Then
     Set Ns = .SeriesCollection.NewSeries
     With Ns
      .XValues = MyR.Columns(1)
      .Values = MyR.Columns(6)
      .AxisGroup = 2
      .ChartType = xlColumnClustered
      .Interior.ColorIndex = 39
      .Border.ColorIndex = 39
     End With
     With .Axes(xlValue, xlSecondary)
      .MaximumScale = 100
      .MinimumScale = 0
     End With
   End If
   With .SeriesCollection(4).Trendlines _
   .Add(Type:=xlMovingAvg, Period:=13).Border
     .ColorIndex = 10
     .Weight = xlHairline
   End With
   With .SeriesCollection(4).Trendlines _
   .Add(Type:=xlMovingAvg, Period:=25).Border
     .ColorIndex = 3
     .Weight = xlHairline
   End With
   .SizeWithWindow = True
   .HasTitle = True
   .ChartTitle.Font.Size = 11
   .ChartTitle.Characters.Text = ChTxt
   .Name = ChTxt
   .Deselect
  End With
  Application.ScreenUpdating = True
End Sub

【9509】Re:グラフの重ね合わせ(2)
質問  NH  - 03/12/5(金) 19:20 -

引用なし
パスワード
   ▼Kein さん:
前回に続き、今回もお手を煩わせてすいません。ソースを貼り付けて実行したところ、

DownBarクラスの Interior プロパティを取得できません が
DownBars.Interior.ColorIndex = 5 の部分でエラーが発生しました。そこでそこの色指定のところをコメントにして実行したところ

Series クラスの Values プロパティを取得できません が
MinV = Int(WorksheetFunction.Min(.SeriesCollection(3).Values))のところで
発生しています。

一応確認なんですが、
 A列  B列 C列 D列 E列  F列   
年月日 始値 高値 安値 終値  %K
にしています。

【9510】Re:グラフの重ね合わせ(2)
回答  Kein  - 03/12/5(金) 20:37 -

引用なし
パスワード
   これでどうでしょーか ?

Sub MyChart_StockData()
  Dim ChTxt As String
  Dim MyR As Range
  Dim MinV As Long, Bet As Long
  Dim Ns As Series
 
  ChTxt = InputBox("グラフタイトルを入力して下さい")
  If ChTxt = "" Then Exit Sub
  Set MyR = Sheets("Sheet1").Range("A1").CurrentRegion
  Application.ScreenUpdating = False
  Charts.Add
  With ActiveChart
   .SetSourceData Source:= _
   Range(MyR.Columns(1), MyR.Columns(5)), _
   PlotBy:=xlColumns
   .ChartType = xlStockOHLC
   .Location Where:=xlLocationAsNewSheet
   .HasLegend = False
   .Axes(xlCategory).CategoryType = xlCategoryScale
   MinV = CLng(WorksheetFunction.Min(MyR.Columns(4))
   With .Axes(xlValue)
     Bet = Int(.MajorUnit)
     .MinimumScale = WorksheetFunction.Floor(MinV, Bet)
   End With
   If MyR.Columns.Count = 6 Then
     Set Ns = .SeriesCollection.NewSeries
     With Ns
      .XValues = MyR.Columns(1)
      .Values = MyR.Columns(6)
      .AxisGroup = 2
      .ChartType = xlColumnClustered
      .Interior.ColorIndex = 39
      .Border.ColorIndex = 39
     End With
     With .Axes(xlValue, xlSecondary)
      .MaximumScale = 100
      .MinimumScale = 0
     End With
   End If
   With .ChartGroups(1)
     .HasUpDownBars = True
     .DownBars.Interior.ColorIndex = 5
     .DownBars.Border.ColorIndex = 5
     .UpBars.Interior.ColorIndex = 6
     .UpBars.Border.ColorIndex = 6
   End With   
   With .SeriesCollection(4).Trendlines _
   .Add(Type:=xlMovingAvg, Period:=13).Border
     .ColorIndex = 10
     .Weight = xlHairline
   End With
   With .SeriesCollection(4).Trendlines _
   .Add(Type:=xlMovingAvg, Period:=25).Border
     .ColorIndex = 3
     .Weight = xlHairline
   End With
   .SizeWithWindow = True
   .HasTitle = True
   .ChartTitle.Font.Size = 11
   .ChartTitle.Characters.Text = ChTxt
   .Name = ChTxt
   .Deselect
  End With
  Application.ScreenUpdating = True
End Sub

【9511】Re:グラフの重ね合わせ(2)
発言  NH  - 03/12/5(金) 20:54 -

引用なし
パスワード
   ▼Kein さん:

誠にすいません。最初のソースで大丈夫でした。こちらの方でシート名を
間違えると言う初歩的なミスです。ごめんなさい。

それでですね、次にいただいたものなんですが、
MinV = CLng(WorksheetFunction.Min(MyR.Columns(4))
のところで構文エラーと言うのがでるんですけど。

大変お手数ばかりおかけいたします。

【9516】Re:グラフの重ね合わせ(2)
回答  Kein  - 03/12/6(土) 0:04 -

引用なし
パスワード
   あー・・すいません。閉じる側の ")" が不足してました。

MinV = CLng(WorksheetFunction.Min(MyR.Columns(4)))

と、修正して下さい。

【9521】Re:グラフの重ね合わせ(2)
お礼  NH  - 03/12/6(土) 9:54 -

引用なし
パスワード
   ▼Kein さん:
>あー・・すいません。閉じる側の ")" が不足してました。
>
>MinV = CLng(WorksheetFunction.Min(MyR.Columns(4)))
>
>と、修正して下さい。

いろいろお付き合いしていただき、有難うございます。
目的を達することが出来ました。これからもひとつよろ
しくお願いします。

12630 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free