返回列表 上一主題 發帖

[發問] 如何將二個不同位置的資料產生一個圖表呢?

回復 1# dechiuan999

是不是這樣?
TESTCHART.rar (11.75 KB)
學海無涯_不恥下問

TOP

回復 3# dechiuan999
試試看
  1. Sub aa()
  2.    
  3.      '貨物存放處統計圖表
  4.    
  5.     Dim mRng As Range
  6.     Dim mRng1 As Range
  7.     Dim mRng2 As Range
  8.     Dim mRng3 As Range
  9.     Dim mRng4 As Range
  10.     Dim mTotal%, mRow$
  11.     Dim oldmonth
  12.     Dim mSht1 As Worksheet
  13.     Dim mChart As ChartObject
  14.     Dim mCol%, sumTotal As Long
  15.    
  16.     Application.ScreenUpdating = False
  17.         
  18.     Set mSht1 = Worksheets("當月統計表及圖表")
  19.     With mSht1
  20.         mCol = .Range("a16").End(xlToRight).Column
  21.         Set mRng = .Range("a17").Resize(5, mCol)
  22.         Set mRng1 = .Range("b25").Resize(5, .Range("b25").End(xlToRight).Column - 1)
  23.         Set mRng2 = Union(mRng, mRng1)
  24.         Set mRng3 = .Range("a1").Resize(14, mCol)
  25.     End With
  26.    
  27.     oldmonth = Month(Date)
  28.     If oldmonth = "1" Then
  29.         oldmonth = "12"
  30.     Else
  31.         oldmonth = oldmonth - 1
  32.     End If
  33.     Call changeMonth(oldmonth)
  34.     Application.ScreenUpdating = False
  35.    
  36.     Set mChart = mSht1.ChartObjects.Add(mRng3.Left, mRng3.Top, mRng3.Width, mRng3.Height)
  37.     With mChart
  38.         .Name = "各關區貨物存放處所統計表"
  39.     End With
  40.    
  41.     mTotal = Application.WorksheetFunction.Max(mRng2)
  42.     Select Case mTotal
  43.    
  44.     Case 1 To 50
  45.         mTotal = "50"
  46.      Case 51 To 100
  47.         mTotal = "100"
  48.     Case 101 To 150
  49.         mTotal = "150"
  50.     Case 151 To 200
  51.         mTotal = "200"
  52.     Case 201 To 250
  53.         mTotal = "250"
  54.     Case 251 To 300
  55.         mTotal = "300"
  56.     Case 301 To 350
  57.         mTotal = "350"
  58.     Case 351 To 400
  59.         mTotal = "400"
  60.     Case 401 To 450
  61.         mTotal = "450"
  62.     Case 451 To 500
  63.         mTotal = "500"
  64.     End Select
  65.    
  66.     Set mRng4 = mSht1.Rows(24).Find(what:="總計 :", after:=mSht1.Range("a24"), LookIn:=xlValues, SearchDirection:=xlPrevious)
  67.     If Not mRng4 Is Nothing Then
  68.         sumTotal = mRng4.Offset(6).Value
  69.     End If
  70.    
  71.     With mChart.Chart
  72.         .SetSourceData Source:=mRng2, PlotBy:=xlRows
  73.         '個別設置數列範圍
  74.     .SeriesCollection(1).XValues = _
  75.         "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
  76.     .SeriesCollection(1).Values = _
  77.         "=(當月統計表及圖表!R18C2:R18C20,當月統計表及圖表!R26C2:R26C6)"
  78.     .SeriesCollection(1).Name = "=當月統計表及圖表!R18C1"
  79.     .SeriesCollection(2).XValues = _
  80.         "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
  81.     .SeriesCollection(2).Values = _
  82.         "=(當月統計表及圖表!R19C2:R19C20,當月統計表及圖表!R27C2:R27C6)"
  83.     .SeriesCollection(2).Name = "=當月統計表及圖表!R19C1"
  84.     .SeriesCollection(3).XValues = _
  85.         "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
  86.     .SeriesCollection(3).Values = _
  87.         "=(當月統計表及圖表!R20C2:R20C20,當月統計表及圖表!R28C2:R28C6)"
  88.     .SeriesCollection(3).Name = "=當月統計表及圖表!R20C1"
  89.     .SeriesCollection(4).XValues = _
  90.         "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
  91.     .SeriesCollection(4).Values = _
  92.         "=(當月統計表及圖表!R21C2:R21C20,當月統計表及圖表!R29C2:R29C6)"
  93.     .SeriesCollection(4).Name = "=當月統計表及圖表!R21C1"
  94.     '刪除錯誤數列
  95.     Do Until .SeriesCollection.Count = 4
  96.     .SeriesCollection(5).Delete
  97.     Loop
  98.     .Location Where:=xlLocationAsObject, Name:="當月統計表及圖表"
  99.         .HasTitle = True
  100.         .ChartType = xlColumnClustered
  101.         .HasLegend = True
  102.         .ApplyDataLabels xlDataLabelsShowValue
  103.         .Axes(xlCategory).TickLabels.Orientation = xlHorizontal
  104.         .ChartTitle.Characters.Text = "  " & oldmonth & " 月份各關區貨物存放處所統計表 (" & sumTotal & " 份)"
  105.         .ChartTitle.Font.Bold = False
  106.         .ChartTitle.Font.Size = 12
  107.         With .Axes(Type:=xlValue)
  108.             .HasTitle = True
  109.             .AxisTitle.Text = "貨物存放處所"
  110.              .AxisTitle.Orientation = xlVertical
  111.              .MaximumScale = mTotal
  112.         End With
  113.         .ChartArea.Font.Size = 8
  114.         .ChartTitle.Font.Size = 10
  115.      End With
  116.      
  117.     Application.ScreenUpdating = True
  118.    
  119.     Set mRng = Nothing
  120.     Set mRng1 = Nothing
  121.     Set mRng2 = Nothing
  122.     Set mRng3 = Nothing
  123.     Set mChart = Nothing
  124. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 口說一句好話,如口出蓮花;口說一句壞話如口吐毒蛇。
返回列表 上一主題