返回列表 上一主題 發帖

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

dechiuan999

帖子
231 
主題
55 
精華
0 
積分
293 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
KEELUNG 
註冊時間
2010-7-24 
最後登錄
2018-8-28 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-4-4 17:02 | 只看該作者

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

本帖最後由 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)

收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-24 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-4-4 19:24 | 只看該作者
回復 1# dechiuan999

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

TOP

dechiuan999

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

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-24 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2012-4-4 23:27 | 只看該作者
回復 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

dechiuan999

帖子
231 
主題
55 
精華
0 
積分
293 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
KEELUNG 
註冊時間
2010-7-24 
最後登錄
2018-8-28 
5#
發表於 2012-4-5 04:58 | 只看該作者
謝謝版主大大。
已測試成功。
下列語法能請版主大大稍做說明其用意嗎？
Do Until .SeriesCollection.Count = 4
.SeriesCollection(5).Delete
Loop

感恩大大！

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2012-4-5 07:38 | 只看該作者
本帖最後由 GBKEE 於 2012-4-5 08:13 編輯

回復 5# dechiuan999
Do Until .SeriesCollection.Count = 4        '執行迴圈:  Until ( 一直到)  條件成立(數列的總數=4 ) 時 不執行迴圈
.SeriesCollection(5).Delete                          '刪除第5個數列資料
Loop
  1. Option Explicit
  2. Sub Ex()
  3.      Dim Rng(2) As Range, xl As Integer
  4.      With Worksheets("當月統計表及圖表")
  5.         .ChartObjects.Delete                            '刪除所有圖表
  6.         Set Rng(0) = .Range("a1").Resize(.[a1].End(xlDown).Row - 1, .[a1].End(xlDown).End(xlToRight).Column)        '圖表放置範圍
  7.         Set Rng(1) = .[B17:T21]                         '基隆,台北港,六堵,南崁長榮,桃園 等關數據
  8.         Set Rng(2) = .[B25:F29]                         '五堵關數據
  9.         With .ChartObjects.Add(Rng(0)(1).Left, Rng(0)(1).Top, Rng(0).Width, Rng(0).Height).Chart
  10.            .Parent.Name = "各關區貨物存放處所統計表"
  11.             For xl = 2 To Rng(1).Rows.Count
  12.                 With .SeriesCollection.NewSeries        '建立新數列
  13.                     .Name = Rng(1).Cells(xl, 0)         '列名稱
  14.                     .Values = "=" & Rng(1).Rows(xl).Address(, , xlR1C1, 1) & "," & Rng(2).Rows(xl).Address(, , xlR1C1, 1)
  15.                                                         '.Values:  新數列的值-> 連接 Rng(1),Rng(2) 的 R1C1式 位址
  16.                     .XValues = "=" & Rng(1).Rows(1).Address(, , xlR1C1, 1) & "," & Rng(2).Rows(1).Address(, , xlR1C1, 1)
  17.                                                         ' .XValues: 新數列 X軸標籤
  18.                 End With
  19.             Next
  20.             .HasTitle = True                            '新增圖表後 沒有指定圖表資料範圍 固須在  資料範圍指定後
  21.            .ChartTitle.Characters.Text = Format(DateAdd("M", -1, Date), "oooo") & " 份各關區貨物存放處所統計表 ( " & Application.Sum(Rng(1), Rng(2)) & " 份)"            
  22.            .ApplyDataLabels AutoText:=True             '自動顯示適當的數值
  23.         End With
  24.     End With
  25. End Sub
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
7#
發表於 2012-4-5 08:11 | 只看該作者
蠻不錯的申論題材，對我個人來說也是一番考驗，
謝謝兩位大大的指導！

TOP

dechiuan999

帖子
231 
主題
55 
精華
0 
積分
293 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
KEELUNG 
註冊時間
2010-7-24 
最後登錄
2018-8-28 
8#
發表於 2012-4-5 17:17 | 只看該作者
謝謝二位版主大大的相助。
測試都很成功。
小弟會先收下
回去好好研究。

感恩二位大大！

TOP

        靜思自在 : 做好事不能少我一人，做壞事不能多我一人。
返回列表 上一主題