返回列表 上一主題 發帖

VBA 畫圖方式請益?????

iverson105

帖子
27 
主題
11 
精華
0 
積分
38 
點名
0  
作業系統
window 
軟體版本
window7 
閱讀權限
10 
性別
男 
註冊時間
2019-12-12 
最後登錄
2021-4-21 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-2-13 16:53 | 顯示全部帖子

VBA 畫圖方式請益?????

請教各位大大:
我有5個以上的sheets資料,想要自動抓取其中column的資料並畫成散布圖(資料sheet不一定,有時超個10個sheets .....請問以下程式會不會太常有可以簡短點嗎?
PS:如果我要畫第二張圖在同一張sheet內,應該怎麼寫(資料也是根據之前的sheet 但不同column)
以下是第一張圖的code:
  1. Sub ALL_PLOT()

  3. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  4. '                                                                             '
  5. '                               Plot Create                                  '
  6. '                                                                             '
  7. '                                                                             '
  8. ' ''''''''''''''''''''''CHART(1) Ave.Ave. G.R. '''''''''''''''''''''''''''''''

  10. ''''''''''''''''''''''''''Chart(1) Ave. G.R. / HSP ADD''''''''''''''''''''''''
  11.   Sheets("R2R_analysis").Select
  12.   ActiveSheet.Shapes.AddChart.Select
  13.     ActiveChart.ChartType = xlXYScatter

  15.    Dim aSh As Worksheet
  16.     Application.ScreenUpdating = False
  17.     For Each aSh In Worksheets
  18.     If aSh.Name = "工作表1 (2)" Then
  19.     Call polt_1
  20.     ElseIf aSh.Name = "工作表1 (3)" Then
  21.     Call polt_2
  22.     ElseIf aSh.Name = "工作表1 (4)" Then
  23.     Call polt_3
  24.     ElseIf aSh.Name = "工作表1 (5)" Then
  25.     Call polt_4
  26.     ElseIf aSh.Name = "工作表1 (6)" Then
  27.     Call polt_5
  28.    
  29.      ElseIf aSh.Name = "工作表1 (7)" Then
  30.     Call polt_6
  31.    
  32.      ElseIf aSh.Name = "工作表1 (8)" Then
  33.     Call polt_7
  34.    
  35.      ElseIf aSh.Name = "工作表1 (9)" Then
  36.     Call polt_8
  37.      ElseIf aSh.Name = "工作表1 (10)" Then
  38.     Call polt_9
  39.    
  40.    
  41.     ElseIf aSh.Name = "工作表1 (11)" Then
  42.     Call polt_10
  43.     ElseIf aSh.Name = "工作表1 (12)" Then
  44.       Call polt_11
  45.       
  46.    End If
  47.         
  48.         
  49.   Next
  50.     Application.ScreenUpdating = True
  51.       
  52. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  53.   ActiveChart.ApplyLayout (4)
  54.    
  55. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  56.    
  57. Dim xRg As Range
  58.      Dim xChart As ChartObject
  59.     Set xRg = Range("A20:J50")
  60.   Set xChart = ActiveSheet.ChartObjects(1)
  61.    With xChart
  62.   .Top = xRg(1).Top
  63. .Left = xRg(1).Left
  64. .Width = xRg.Width
  65. .Height = xRg.Height
  66.    End With
  67. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  68.    
  69.    ActiveChart.SetElement (msoElementChartTitleAboveChart)
  70.     Selection.Caption = "R2R_Ave.G.R."
  71.     ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
  72.     Selection.Caption = "G.R.(mm/hr)"
  73.     ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
  74.     Selection.Caption = "Length(mm)"
  75.    
  76.     ActiveSheet.ChartObjects(1).Activate
  77.     ActiveChart.Axes(xlCategory).Select
  78.     ActiveChart.Axes(xlCategory).MinimumScale = 0
  79.     ActiveChart.Axes(xlCategory).MaximumScale = 1100
  80.     ActiveChart.Axes(xlCategory).MajorUnit = 100
  81.     ActiveChart.Axes(xlCategory).MinorUnit = 50
  82.     ActiveChart.Axes(xlCategory).CrossesAt = 0
  83.     ActiveChart.Axes(xlValue).CrossesAt = 0

  85.     ActiveChart.SetElement (msoElementPrimaryValueGridLinesMajor)
  86.     ActiveChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
  87.   

  89.     Application.ScreenUpdating = True
  90.   
  91.   
  92.   

  94.   
  95. End Sub
  96. Sub polt_1()
  97.    
  98.     ActiveChart.SeriesCollection.NewSeries
  99.     ActiveChart.SeriesCollection(1).Name = Sheets("工作表1 (2)").Range("U1")
  100.     ActiveChart.SeriesCollection(1).XValues = "='工作表1 (2)'!$A$2:$A$20000"
  101.     ActiveChart.SeriesCollection(1).Values = "='工作表1 (2)'!$D$2:$D$20000"
  102.    
  103. End Sub
  104. Sub polt_2()
  105.     ActiveChart.SeriesCollection.NewSeries
  106.     ActiveChart.SeriesCollection(2).Name = Sheets("工作表1 (3)").Range("U1")
  107.     ActiveChart.SeriesCollection(2).XValues = "='工作表1 (3)'!$A$2:$A$20000"
  108.     ActiveChart.SeriesCollection(2).Values = "='工作表1 (3)'!$D$2:$D$20000"
  109.    
  110.   End Sub

  112. Sub polt_3()
  113.     ActiveChart.SeriesCollection.NewSeries
  114.     ActiveChart.SeriesCollection(3).Name = Sheets("工作表1 (4)").Range("U1")
  115.     ActiveChart.SeriesCollection(3).XValues = "='工作表1 (4)'!$A$2:$A$20000"
  116.     ActiveChart.SeriesCollection(3).Values = "='工作表1 (4)'!$D$2:$D$20000"
  117.    
  118.   End Sub

  120. Sub polt_4()
  121.     ActiveChart.SeriesCollection.NewSeries
  122.     ActiveChart.SeriesCollection(4).Name = Sheets("工作表1 (5)").Range("U1")
  123.     ActiveChart.SeriesCollection(4).XValues = "='工作表1 (5)'!$A$2:$A$20000"
  124.     ActiveChart.SeriesCollection(4).Values = "='工作表1 (5)'!$D$2:$D$20000"
  125.    
  126.   End Sub

  128. Sub polt_5()
  129.     ActiveChart.SeriesCollection.NewSeries
  130.     ActiveChart.SeriesCollection(5).Name = Sheets("工作表1 (6)").Range("U1")
  131.     ActiveChart.SeriesCollection(5).XValues = "='工作表1 (6)'!$A$2:$A$20000"
  132.     ActiveChart.SeriesCollection(5).Values = "='工作表1 (6)'!$D$2:$D$20000"
  133.    
  134.   End Sub


  137. Sub polt_6()
  138.     ActiveChart.SeriesCollection.NewSeries
  139.     ActiveChart.SeriesCollection(6).Name = Sheets("工作表1 (7)").Range("U1")
  140.     ActiveChart.SeriesCollection(6).XValues = "='工作表1 (7)'!$A$2:$A$20000"
  141.     ActiveChart.SeriesCollection(6).Values = "='工作表1 (7)'!$D$2:$D$20000"
  142.    
  143.   End Sub

  145. Sub polt_7()
  146.     ActiveChart.SeriesCollection.NewSeries
  147.     ActiveChart.SeriesCollection(7).Name = Sheets("工作表1 (8)").Range("U1")
  148.     ActiveChart.SeriesCollection(7).XValues = "='工作表1 (8)'!$A$2:$A$20000"
  149.     ActiveChart.SeriesCollection(7).Values = "='工作表1 (8)'!$D$2:$D$20000"
  150.    
  151.   End Sub
  152.   Sub polt_8()
  153.     ActiveChart.SeriesCollection.NewSeries
  154.     ActiveChart.SeriesCollection(8).Name = Sheets("工作表1 (9)").Range("U1")
  155.     ActiveChart.SeriesCollection(8).XValues = "='工作表1 (9)'!$A$2:$A$20000"
  156.     ActiveChart.SeriesCollection(8).Values = "='工作表1 (9)'!$D$2:$D$20000"
  157.    
  158.   End Sub
  159.    Sub polt_9()
  160.     ActiveChart.SeriesCollection.NewSeries
  161.     ActiveChart.SeriesCollection(9).Name = Sheets("工作表1 (10)").Range("U1")
  162.     ActiveChart.SeriesCollection(9).XValues = "='工作表1 (10)'!$A$2:$A$20000"
  163.     ActiveChart.SeriesCollection(9).Values = "='工作表1 (10)'!$D$2:$D$20000"
  164.    
  165.   End Sub
  166.    Sub polt_10()
  167.     ActiveChart.SeriesCollection.NewSeries
  168.     ActiveChart.SeriesCollection(10).Name = Sheets("工作表1 (11)").Range("U1")
  169.     ActiveChart.SeriesCollection(10).XValues = "='工作表1 (11)'!$A$2:$A$20000"
  170.     ActiveChart.SeriesCollection(10).Values = "='工作表1 (11)'!$D$2:$D$20000"
  171.     End Sub
  172. Sub polt_11()
  173. ActiveChart.SeriesCollection.NewSeries
  174.     ActiveChart.SeriesCollection(11).Name = Sheets("工作表1 (12)").Range("U1")
  175.     ActiveChart.SeriesCollection(11).XValues = "='工作表1 (12)'!$A$2:$A$20000"
  176.     ActiveChart.SeriesCollection(11).Values = "='工作表1 (12)'!$D$2:$D$20000"
  177. End Sub
複製代碼
Tks
收藏 分享
Ian

iverson105

帖子
27 
主題
11 
精華
0 
積分
38 
點名
0  
作業系統
window 
軟體版本
window7 
閱讀權限
10 
性別
男 
註冊時間
2019-12-12 
最後登錄
2021-4-21 
2#
發表於 2020-2-19 11:41 | 顯示全部帖子
回復 2# jcchiang

感謝大大的回覆
但在跑的時候出現錯誤????????
再麻煩指教!

謝謝
  1. Sub ALL_PLOT_TEST()
  2. Dim x As Integer
  3. Sheets("R2R_analysis").Select
  4. ActiveSheet.Shapes.AddChart.Select
  5. ActiveChart.ChartType = xlXYScatter
  6. Application.ScreenUpdating = False
  7. For x = 2 To Worksheets.Count
  8.    ActiveChart.SeriesCollection.NewSeries
  9.    ActiveChart.SeriesCollection(x - 1).Name = Sheets("工作表1 (" & x & ")").Range("U1")   .....................................................(請問這段出錯誤(陣列索引 超出範圍) 要如何修正
  10.    ActiveChart.SeriesCollection(x - 1).XValues = Sheets("工作表1 (" & x & ")").Range("A2:A20000")
  11.    ActiveChart.SeriesCollection(x - 1).Values = Sheets("工作表1 (" & x & ")").Range("D2:D20000")
  12. Next
  13. Application.ScreenUpdating = True
複製代碼
Ian

TOP

iverson105

帖子
27 
主題
11 
精華
0 
積分
38 
點名
0  
作業系統
window 
軟體版本
window7 
閱讀權限
10 
性別
男 
註冊時間
2019-12-12 
最後登錄
2021-4-21 
3#
發表於 2020-2-19 13:57 | 顯示全部帖子
感謝大大的指教
想在請問一下
以下的code
1.可以改成圖表放置的位置是依我只是的位置固定嗎(ex:Plot1 在 A20:J50  '  plot2在L20:U50........以此類推)
2.還有坐標軸可自己先寫在code中嗎? 因為每一張圖的座標軸明成不一樣

感謝
  1. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2. Dim xRg As Range
  3. Dim xChart As ChartObject
  4. Set xRg = Range("A20:J50")..........................................................................................(問題1)
  5. Set xChart = ActiveSheet.ChartObjects(z)
  6. With xChart
  7.    .Top = xRg(z).Top
  8.    .Left = xRg(z).Left
  9.    .Width = xRg.Width
  10.    .Height = xRg.Height
  11. End With

  13. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  14. ActiveChart.SetElement (msoElementChartTitleAboveChart)
  15. Selection.Caption = "R2R_Ave.G.R." & z...........................................................................................(問題2)
  16. ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
  17. Selection.Caption = "G.R.(mm/hr)"..........................................................................................(問題2)
  18. ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
  19. Selection.Caption = "Length(mm)"
複製代碼
回復 3# jcchiang
Ian

TOP

iverson105

帖子
27 
主題
11 
精華
0 
積分
38 
點名
0  
作業系統
window 
軟體版本
window7 
閱讀權限
10 
性別
男 
註冊時間
2019-12-12 
最後登錄
2021-4-21 
4#
發表於 2020-2-19 13:59 | 顯示全部帖子
回復 5# jcchiang

好喔!  晚點傳
(上班中 工作電腦傳不出去)   

感謝
Ian

TOP

iverson105

帖子
27 
主題
11 
精華
0 
積分
38 
點名
0  
作業系統
window 
軟體版本
window7 
閱讀權限
10 
性別
男 
註冊時間
2019-12-12 
最後登錄
2021-4-21 
5#
發表於 2020-2-24 01:19 | 顯示全部帖子
回復 9# jcchiang


    感謝大大的回覆 ,我再試一下,感應不盡


謝謝
Ian

TOP

iverson105

帖子
27 
主題
11 
精華
0 
積分
38 
點名
0  
作業系統
window 
軟體版本
window7 
閱讀權限
10 
性別
男 
註冊時間
2019-12-12 
最後登錄
2021-4-21 
6#
發表於 2020-2-24 15:14 | 顯示全部帖子
回復 9# jcchiang

感謝喔, 可以使用喔(可照我要的修改)


謝謝
Ian

TOP

        靜思自在 : 待人退一步，愛人寬一寸，就會活得很快樂。
返回列表 上一主題