返回列表 上一主題 發帖

請問有人有用vba做過大盤的河流圖嗎

請問有人有用vba做過大盤的河流圖嗎

請問有人有用vba做過大盤的河流圖嗎
如何做
謝謝:P

用錄製巨集,我只可各別錄股價圖、折線圖
請問如何做在一起,謝謝

TOP

例如附件中的檔案

data.rar (724.13 KB)

TOP

回復 3# wufonna
依你附檔所寫的,試試看
  1. Sub Ex()
  2.     Dim E As Variant
  3.     Dim Rng(1 To 2) As Range
  4.     With 工作表1                                                                                 '工作表 (Sheet 物件)
  5.         Set Rng(1) = .Range(.[B1], .[B1].End(xlDown)).Resize(, 4)                                '第一圖表來源資料範圍
  6.         Set Rng(2) = .Range(.[I1], .[I1].End(xlDown)).Resize(, 4)                                '第二圖表來源資料範圍
  7.         .ChartObjects.Delete                                                                     '刪除所有圖表
  8.         For Each E In Rng
  9.           'ChartObjects 方法,該物件既可代表單一內嵌圖表 (ChartObject 物件)、也可代表工作表上所有內嵌圖表的集合 (ChartObjects 物件)。
  10.           With .ChartObjects.Add(E.Left, E.Top, E.Resize(, 11).Width, E.Resize(15).Height).Chart  'Chart(物件)
  11.                    '新增圖表 Add( 左邊位置 , 上方位置 , 圖表寬度 ,圖表高度 )
  12.                 .ChartType = xlLine                                                               '指定圖表類型
  13.                 .SetSourceData E                                                                  '為指定圖表設定來源資料範圍。
  14.                 .SeriesCollection(1).XValues = E.Parent.Range("A2:A" & E.Rows.Count - 1)          'X軸的標籤位置
  15.                 .Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d;@"                     'X軸的標籤數值格式
  16.           End With
  17.         Next
  18.     End With
  19. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

謝謝 GBKEE  大
執行後還是兩個圖表
希望執行後像 img.JPG 這樣
謝謝

data2.rar (695.53 KB)

TOP

回復 5# wufonna
依你附檔的資料所寫,如有須再修改請自行,用錄製巨集的程式碼修改試試看.
  1. Sub Ex()
  2.     Dim E As Variant, I As Integer
  3.     Dim Rng(1 To 2) As Range
  4.     With 工作表1                                                                                 '工作表 (Sheet 物件)
  5.         Set Rng(1) = .Range(.[B2], .[B2].End(xlDown)).Resize(, 4)                                '第一圖表來源資料範圍
  6.         Set Rng(2) = .Range(.[I2], .[I2].End(xlDown)).Resize(, 4)                                '第二圖表來源資料範圍
  7.         .ChartObjects.Delete                                                                     '刪除所有圖表
  8.           'ChartObjects 方法,該物件既可代表單一內嵌圖表 (ChartObject 物件)、也可代表工作表上所有內嵌圖表的集合 (ChartObjects 物件)。
  9.         With .ChartObjects.Add(Rng(1).Left, Rng(1).Top, Rng(1).Resize(, 11).Width, Rng(1).Resize(15).Height).Chart  'Chart(物件)
  10.                    '新增圖表 Add( 左邊位置 , 上方位置 , 圖表寬度 ,圖表高度 )
  11.                 .ChartType = xlLine                                                               '指定圖表類型
  12.                 '.SetSourceData Union(Rng(1), Rng(2))                                             '為指定圖表設定來源資料範圍。
  13.                 For Each E In Rng(1).Columns                                                      '
  14.                     .SeriesCollection.NewSeries                                                   '新增數列
  15.                     I = .SeriesCollection.Count
  16.                     .SeriesCollection(I).Values = E
  17.                     .SeriesCollection(I).Name = E.Cells(0).Text
  18.                 Next
  19.                 For Each E In Rng(2).Columns
  20.                     .SeriesCollection.NewSeries
  21.                     I = .SeriesCollection.Count
  22.                     .SeriesCollection(I).Values = E
  23.                     .SeriesCollection(I).Name = E.Cells(0).Text
  24.                     .SeriesCollection(I).AxisGroup = xlSecondary
  25.                 Next
  26.                 .SeriesCollection(1).XValues = Parent.Parent.Range("A2:A" & Rng(1).Rows.Count - 1)          'X軸的標籤位置
  27.                 .Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d;@"                     'X軸的標籤數值格式
  28.                   With .Axes(xlValue)             'Y(主)座標軸
  29.                     .MinimumScale = Application.Min(Rng(1))                        '最小值
  30.                     .MaximumScale = Application.Max(Rng(1))                        '最大值
  31.                     .MajorUnitIsAuto = True      '主要刻度間距=自動設定
  32.                     .MinorUnitIsAuto = True      '次要刻度間距=自動設定
  33.                     .Crosses = xlAutomatic       '座標軸與其他座標軸交叉的點=自動設定
  34.                     .ScaleType = xlLinear        '數值座標軸的刻度類型=xlLinear
  35.                 End With
  36.                 With .Axes(xlValue, xlSecondary) 'Y(副)座標軸
  37.                     .MinimumScale = Application.Min(Rng(2))                        '最小值
  38.                     .MaximumScale = Application.Max(Rng(2))                        '最大值
  39.                     .MaximumScaleIsAuto = True
  40.                     .MajorUnitIsAuto = True
  41.                     .MinorUnitIsAuto = True
  42.                     .Crosses = xlAutomatic
  43.                     .ScaleType = xlLinear
  44.                 End With
  45.         End With
  46.     End With
  47. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

謝謝 GBKEE  大
我再研究程式碼看看
不會再請教大大
真的非常謝謝^0^

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題