| 1 | パレート図で、折線グラフの位置を、棒グラフの右端にずらすには |
|
クリックすると大きくなります |
1. グラフのアイコンをクリックし、「グラフウィザード」で、 「ユーザー設定」、「２軸上の折れ線と縦棒」を選択。 2. 「次へ」で次の画面の、データ範囲を指定し、「系列」で、 「系列1」のほうの「名前」を「=Sheet1!$A$2」に、 「系列2」のほうの「名前」を「=Sheet1!$A$3」に、 「系列2」のほうの「値」を「=Sheet1!$B$3:$H$3」に変更。 （各欄の右側のボタンで直接セル範囲からも選択可） 「次へ」で進んで3/4ページで「軸」を開き、 「第２軸（上／右側）」の「X／項目軸」にチェックを入れます （これで全てのチェックボックスにチェックが入ります） 3. 次に、棒グラフを右クリック、「データ系列の書式設定」 「オプション」、「棒の間隔」を「0」にし、 隙間のないグラフにします。 4. 次に、上側のＸ軸を右クリック、「軸の書式設定」→ 「目盛」ページで「項目境界で交差する」のチェックを外す。 あとは左右のＹ軸を右クリックし、 「軸の書式設定」で目盛範囲を任意に設定します。 |
|
| 2 | パレート図をマクロで描くには |
|
| 上記No.1の操作をマクロにしました。データ範囲をドラッグ（上の図の例だと、A1からH3のセル）して指定します。 Sub パレート図作成() Dim aa As Variant, bb As Variant, LastCol As Integer, data As Range Dim kei As Variant, i As Integer, WS As Worksheet, N As String On Error GoTo ERROR1 Application.DisplayAlerts = False '警告を非表示 'グラフを作成するデータ範囲を指定 'ここでデータ範囲を指定します。 Set data = Application.InputBox("データ範囲のセルを選択して下さい", "セルの指定", Type:=8) Application.ScreenUpdating = False '画面更新停止 N = ActiveSheet.Name Set WS = Sheets(N) LastCol = WS.Cells(1, Columns.Count).End(xlToLeft).Column '１行目最終列取得 '系列１のデータを合計 kei = WS.Cells(2, 3) For i = 4 To LastCol kei = kei + WS.Cells(2, i) Next aa = Application.InputBox(Prompt:="左の軸の最大値を入力してください", Default:=kei, Type:=1) bb = Application.InputBox(Prompt:="右の軸の最大値を入力してください", Default:=100, Type:=1) 'InputBoxのキャンセル処理 If (VarType(aa) = vbBoolean) Then Exit Sub End If If (VarType(bb) = vbBoolean) Then Exit Sub End If On Error GoTo ERROR2 Charts.Add ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="2 軸上の折れ線と縦棒" 'グラフのデータ範囲を設定 ActiveChart.SetSourceData Source:=data '折れ線グラフのデータ範囲を設定 ActiveChart.SeriesCollection(2).Values = "=" & N & "!R3C2:R3C" & LastCol ActiveChart.Location Where:=xlLocationAsObject, Name:=N With ActiveChart .SeriesCollection(2).AxisGroup = 2 'インデックス番号 .SeriesCollection(2).ChartType = xlLineMarkers 'データ マーカー付き折れ線グラフ .HasAxis(xlCategory, xlPrimary) = True '系列１のＸ軸を表示 .HasAxis(xlCategory, xlSecondary) = True '系列２のＸ軸を表示 .HasAxis(xlValue, xlPrimary) = True '系列１のＹ軸を表示 .HasAxis(xlValue, xlSecondary) = True '系列２のＹ軸を表示 End With '系列１、棒グラフの間隔を0にする With ActiveChart.ChartGroups(1) .Overlap = 0 .GapWidth = 0 End With '系列２のＸ軸で、項目の境界で数値軸が項目軸と交差しない ActiveChart.Axes(xlCategory, xlSecondary).AxisBetweenCategories = False With ActiveChart.Axes(xlValue) '系列１のＹ軸 .MaximumScale = aa '左の軸の最大値 .MinimumScale = 0 '左の軸の最小値 End With With ActiveChart.Axes(xlValue, xlSecondary) '系列２のＹ軸 .MaximumScale = bb '右の軸の最大値 .MinimumScale = 0 '右の軸の最小値 End With Application.ScreenUpdating = True '画面更新停止を再開 Application.DisplayAlerts = True '警告を再表示 Exit Sub ERROR1: Exit Sub ERROR2: MsgBox "必要なデータがありません。あるいはシートの名前に（）を使っています" Application.DisplayAlerts = False '警告を非表示 ActiveWindow.SelectedSheets.Delete '未完成のグラフシートを削除 Application.DisplayAlerts = True '警告を再表示 End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
||
| 3 | セルをクリックして、グラフのデータを変更するには？ |
|
| この様なデータシートで、Sheet14に作成された折れ線グラフを対象にしました。
***** Sheet13 ***** A B C D E F G H I J K L M 1 2 3 4 5 6 氏名 1月 2月 3月 4月 5月 6月 7月 8月 9月 10月 11月 12月 7 A 50 52 51 52 51 53 51 52 51 55 52 51 8 B 60 62 61 62 63 62 61 62 63 61 62 63 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim gyou As Long, retu As Integer, data As Variant gyou = Target.Row retu = Target.Column If gyou < 6 Or retu <> 1 Then Exit Sub If Target.Value = "" Then MsgBox "データがありません" Exit Sub End If data = Range(Cells(gyou, 1), Cells(gyou, 13)).Address(RowAbsolute:=False, ColumnAbsolute:=False) Sheets("Sheet14").Select ActiveSheet.ChartObjects("グラフ 1").Activate ActiveChart.SeriesCollection(1).Select ActiveChart.SetSourceData Source:=Sheets("Sheet13").Range(data), PlotBy:=xlRows Cancel = True End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
||
| 4 | グラフのデータ範囲に変数を使うには？ |
|
| 例えば、 ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("B2:D7"), PlotBy:= xlColumns の場合、下のように B2:D7 を直接 Cells に置き換えるとエラーになります。 ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(Cells(a, b), Cells(c, d)), PlotBy:= xlColumns この場合、一旦AddressプロパティでA1:B2形式にして変数に格納します。 data = Range(Cells(a, b), Cells(c, d)).Address(RowAbsolute:=False, ColumnAbsolute:=False) ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(data), PlotBy:=xlColumns また、次のようなR1C1形式の場合 ActiveChart.SeriesCollection(1).XValues="='Sheet1'!R4C2:R110C2" 変数以外のところを "" で囲って & で繋ぎます。 ActiveChart.SeriesCollection(1).XValues = "='Sheet1'!R" & a & "C" & b & ":R" & c & "C" & d このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
||
| 5 | 数値を直接コードからに指定してグラフを作成するには？ |
|
| Sub Test() Dim x As Variant Dim y As Variant Dim co As ChartObject x = Array(1, 2, 3) y = Array(10, 20, 30) Set co = ActiveSheet.ChartObjects.Add(10, 10, 300, 200) With co.Chart.SeriesCollection.NewSeries .Values = y .XValues = x End With End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
||
| Sub Test2() Dim i As Integer, x As Variant, y As Variant Dim co As ChartObject x = "={" y = "={" For i = 1 To 9 x = x & i & "," y = y & i + 1 & "," Next i x = x & i & "}" y = y & i + 1 & "}" Set co = ActiveSheet.ChartObjects.Add(10, 10, 300, 200) co.Chart.ChartType = xlXYScatter With co.Chart.SeriesCollection.NewSeries .Values = y .XValues = x End With End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
||
| 6 | 複数範囲のグラフを一括して作成するには？ |
|
クリックすると、大きくなります Sub Graph() |
||
| 7 | 既存のグラフをサイズを揃えてきれいに並べるには？ |
|
| シート内に全てのグラフを、任意の大きさで、指定の場所に整列させます Sub miko_Test4() Dim ch Dim a As String, b As String, i As Integer, j As Integer, k As Integer Dim m As Double, n As Double, p As Long, q As Long, r As Long, s As Long Dim aa As Range, mm As Double, nn As Double On Error GoTo TRAP a = Application.InputBox(Prompt:="横に何個のグラフを作成しますか？", Type:=1) b = Application.InputBox(Prompt:="縦に何個のグラフを作成しますか？", Type:=1) p = Application.InputBox(Prompt:="横幅は何ポイントにしますか？", Default:=200, Type:=1) '横幅 q = Application.InputBox(Prompt:="縦幅は何ポイントにしますか？", Default:=100, Type:=1) '縦幅 r = Application.InputBox(Prompt:="横間隔は何ポイントに空けますか？", Default:=20, Type:=1) s = Application.InputBox(Prompt:="縦横間隔は何ポイントに空けますか？", Default:=20, Type:=1) Set aa = Application.InputBox("最初にグラフを表示するセルをクリックして下さい", "セルの指定", Type:=8) mm = aa.Left nn = aa.Top m = mm - p n = nn - q k = 0 For i = 1 To b n = n + q + s For j = 1 To a m = m + p + r k = k + 1 Set ch = Worksheets("Sheet1").ChartObjects(k) If ch Is Nothing Then Exit Sub With ch .Left = m .Top = n .Width = p .Height = q End With Next j m = mm - p Next i TRAP: End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
||
| 8 | シート内の全てのグラフのフォントサイズを一気に変更するには？ |
|
| Sub
全グラフ変更_グラフエリアの書式設定() Dim ch Dim a As Integer, k As Integer On Error GoTo PRO2 a = Application.InputBox(Prompt:="フォントサイズはいくつにしますか？", Default:=10, Type:=1) k = 0 Do k = k + 1 Set ch = Worksheets("Sheet1").ChartObjects(k) If ch Is Nothing Then Exit Sub ch.Activate ActiveChart.ChartArea.Select Selection.Font.Size = a 'フォントサイズを指定の数値に変更 Loop PRO2: End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
||
| 9 | 任意の設定のグラフをデフォルトにするには？ |
|
| グラフウィザードを起動して、【完了】ボタンを押しただけで作られるグラフです。 デフォルトだと、タイトルのない棒グラフになっていると思います。 1. まず、好みの設定のグラフを作ります。 2. 作ったグラフを選択し、右クリック【グラフの種類】【ユーザー設定】 選択元【ユーザー定義】にチェックを入れ、【追加】。 適当な名前を入れて、【ＯＫ】。 【標準グラフに設定】ボタンをクリック、【ＯＫ】です。 ※ デフォルトのグラフを元に戻すには、【ユーザー定義】で追加したグラフと、 それが標準になったグラフを削除すればＯＫです。 |
||
| 10 | 積み上げ縦棒グラフ＋折れ線グラフを作成するには？ |
|
| 1. データ範囲を選択し、グラフウィザードで【積み上げ縦棒】グラフを作ります。 2. 折れ線グラフにしたい棒グラフの系列を選択し、右クリック【グラフの種類】で【折れ線グラフ】を選択します。 |
||