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

本帖最後由 dechiuan999 於 2012-4-4 20:30 編輯

各位大大好：

小弟要將一工作表的不同位置的資料
同時產生一個圖表，但無法將二個不同位置的資料產
生一個圖表。
請問各位大大此問題應如何克服呢？

說明如下：
圖表區塊為
要將此二個區塊RANGE("B2:T22")及RANE("B25:F29")合併並
產生一個圖表

圖表位置：
RANGE("A1").RESIZE(14,20)

下列為小弟之語法應如何修正呢
Sub aa()

   '貨物存放處統計圖表

Dim mRng As Range
Dim mRng1 As Range
Dim mRng2 As Range
Dim mRng3 As Range
Dim mRng4 As Range
Dim mTotal%, mRow$
Dim oldmonth
Dim mSht1 As Worksheet
Dim mChart As ChartObject
Dim mCol%, sumTotal As Long

Application.ScreenUpdating = False

Set mSht1 = Worksheets("當月統計表及圖表")
With mSht1
      mCol = .Range("a16").End(xlToRight).Column
      Set mRng = .Range("a17").Resize(5, mCol)
      Set mRng1 = .Range("b25").Resize(5, .Range("b25").End(xlToRight).Column - 1)
      Set mRng2 = Union(mRng, mRng1)
      Set mRng3 = .Range("a1").Resize(14, mCol)
End With

oldmonth = Month(Date)
If oldmonth = "1" Then
      oldmonth = "12"
Else
      oldmonth = oldmonth - 1
End If
Call changeMonth(oldmonth)
Application.ScreenUpdating = False

Set mChart = mSht1.ChartObjects.Add(mRng3.Left, mRng3.Top, mRng3.Width, mRng3.Height)
With mChart
      .Name = "各關區貨物存放處所統計表"
End With

mTotal = Application.WorksheetFunction.Max(mRng2)
Select Case mTotal

Case 1 To 50
      mTotal = "50"
   Case 51 To 100
      mTotal = "100"
Case 101 To 150
      mTotal = "150"
Case 151 To 200
      mTotal = "200"
Case 201 To 250
      mTotal = "250"
Case 251 To 300
      mTotal = "300"
Case 301 To 350
      mTotal = "350"
Case 351 To 400
      mTotal = "400"
Case 401 To 450
      mTotal = "450"
Case 451 To 500
      mTotal = "500"
End Select

Set mRng4 = mSht1.Rows(24).Find(what:="總計：", after:=mSht1.Range("a24"), LookIn:=xlValues, SearchDirection:=xlPrevious)
If Not mRng4 Is Nothing Then
      sumTotal = mRng4.Offset(6).Value
End If

With mChart.Chart
      .SetSourceData Source:=mRng2, PlotBy:=xlRows
      .HasTitle = True
      .ChartType = xlColumnClustered
      .HasLegend = True
      .ApplyDataLabels xlDataLabelsShowValue
      .Axes(xlCategory).TickLabels.Orientation = xlHorizontal
      .ChartTitle.Characters.Text = "  " & oldmonth & " 月份各關區貨物存放處所統計表 (" & sumTotal & " 份)"
      .ChartTitle.Font.Bold = False
      .ChartTitle.Font.Size = 12
      '.PlotArea.Top = 16
      '.PlotArea.Height = 160
      With .Axes(Type:=xlValue)
         .HasTitle = True
         .AxisTitle.Text = "貨物存放處所"
         .AxisTitle.Orientation = xlVertical
         .MaximumScale = mTotal
      End With
      '.Axes(xlCategory, xlPrimary).HasTitle = False  ''false
      '.Axes(xlValue, xlPrimary).HasTitle = False ''false
      .ChartArea.Font.Size = 8
      .ChartTitle.Font.Size = 10
   End With

Application.ScreenUpdating = True

Set mRng = Nothing
Set mRng1 = Nothing
Set mRng2 = Nothing
Set mRng3 = Nothing
Set mChart = Nothing
End Sub

謝謝各位大大！

CHART2.rar (17.11 KB)

樓主熱帖

dechiuan999

中學生 Rank: 2

帖子: 231
主題: 55
精華: 0
積分: 293
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: KEELUNG
註冊時間: 2010-7-24
最後登錄: 2018-8-28

2^#

發表於 2012-4-4 20:31 | 顯示全部帖子

謝謝版主大大。
看起來已接近小弟的需求，
但小弟仍想達成此範例的
圖表樣式。
(小弟已重新上傳檔案)
下列是小弟重新調整的圖表
只是少了範圍RANGE("B25:F29")
的位置。

語法如下：
Private Sub CommandButton1_Click()

Dim mRng As Range
Dim mRng1 As Range
Dim mRng2 As Range
Dim mRng3 As Range
Dim mTotal%, mRow$
Dim oldmonth
Dim mSht1 As Worksheet
Dim mChart As ChartObject
Dim mCol%, sumTotal As Long

Application.ScreenUpdating = False


Set mSht1 = Worksheets("當月統計表及圖表")
With mSht1
      mCol = .Range("a16").End(xlToRight).Column
      Set mRng = .Range("a1").Resize(14, mCol)

      Set mRng1 = .Range("a17").Resize(5, mCol)
      Set mRng2 = .Range("b26").Resize(5, 5)
      Set mRng3 = Union(mRng1, mRng2)    'mRng3是將二個區塊合併並導入.SetSourceData Source:=mRng3, PlotBy:=xlRows 則會失敗收場

End With

oldmonth = Month(Date)

If oldmonth = "1" Then
      oldmonth = "12"
Else
      oldmonth = oldmonth - 1
End If

Call changeMonth(oldmonth)
Application.ScreenUpdating = False
Set mChart = mSht1.ChartObjects.Add(mRng.Left, mRng.Top, mRng.Width, mRng.Height)
With mChart
      .Name = "各關區貨物存放處所統計表"
End With
mTotal = Application.WorksheetFunction.Max(mRng3)
Select Case mTotal
Case 1 To 50
      mTotal = "50"
   Case 51 To 100
      mTotal = "100"
Case 101 To 150
      mTotal = "150"
Case 151 To 200
      mTotal = "200"
Case 201 To 250
      mTotal = "250"
Case 251 To 300
      mTotal = "300"
Case 301 To 350
      mTotal = "350"
Case 351 To 400
      mTotal = "400"
Case 401 To 450
      mTotal = "450"
Case 451 To 500
      mTotal = "500"
End Select
Set mRng3 = mSht1.Rows(24).Find(what:="總計：", after:=mSht1.Range("a24"), LookIn:=xlValues, SearchDirection:=xlPrevious)
If Not mRng3 Is Nothing Then
      sumTotal = mRng3.Offset(6).Value
End If

With mChart.Chart
      .SetSourceData Source:=mRng1, PlotBy:=xlRows '目前執行mrng1 而少了mrng2的區塊位置，但如果改為mRng3時卻無法達成二個區塊
      .HasTitle = True
      .ChartType = xlColumnClustered
      .HasLegend = True
      .ApplyDataLabels xlDataLabelsShowValue
      .Axes(xlCategory).TickLabels.Orientation = xlHorizontal
      .ChartTitle.Characters.Text = "  " & oldmonth & " 月份各關區貨物存放處所統計表 (" & sumTotal & " 份)"
      .ChartTitle.Font.Bold = False
      .ChartTitle.Font.Size = 12
      With .Axes(Type:=xlValue)
         .HasTitle = True
         .AxisTitle.Text = "貨物存放處所"
         .AxisTitle.Orientation = xlVertical
         .MaximumScale = mTotal
      End With
      .ChartArea.Font.Size = 8
      .ChartTitle.Font.Size = 10
   End With
Application.ScreenUpdating = True
Set mRng = Nothing
Set mRng1 = Nothing
Set mRng2 = Nothing
Set mRng3 = Nothing
Set mChart = Nothing
End Sub

TOP

dechiuan999