Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : その他)
エクセルのグラフの項目名の間隔を調整したい
投稿日時: 21/11/02 18:54:50
投稿者: match13

作成したエクセルのチャート
https://youtu.be/lxVZpze1Iro
↑リンクのように、動くグラフ、をエクセルで作りました。
 
やりたいこと4個
@上の折れ線グラフと下の棒グラフで、項目名A〜Kは同じなので、上下のグラフで横の位置を合わせたい。
 
A左に行くほど項目の間隔を狭くし、右側を広くしたい。(おそらく@ができれば応用できそう)
イメージ A,B,Cは1cm間隔で、IJKは3cm間隔。
 
B棒グラフの項目名を2行にする
「A」を「東京都中央区」に変更した際に下記のように2行で表示したい
東京都
中央区
 
C棒グラフのy軸のメモリを ‐0.5 〜 +0.5 で固定したい。
 
 
使用環境
MacBook Pro (Retina, 13-inch, Mid 2014)
OS boot camp の ウィンドウズ10 pro
Excel Office Professional Plus 2019
 
以下にソースを記載しますが、専用書式のデータでないと、うまく動かないと思います。
 
 
 
#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
 
Sub 折れ線グラフと棒グラフ()
Dim I, p, q As Long
Dim chrt As Shape
'棒グラフの色変更に使う変数
Dim tmp As Variant, J As Long
 
 
'チャートからループで直前に描写したグラフを削除するためのプログラム
Dim ChrtObj As ChartObject
'変数宣言 削除する系列を格納する変数
Dim deleteTarget As Integer
'前回の表示分である1列目を指定
deleteTarget = 1
 
 
'[A]すでにグラフがある場合は削除
For Each chrt In ActiveSheet.Shapes
    chrt.Delete
Next chrt
 
 
 
'[B]空のグラフを作成
' データ系列が設定されてしまった場合は削除
ActiveSheet.Shapes.AddChart.Chart.ChartType = xlLine
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.ClearContents
'チャートの凡例を削除
ActiveChart.HasLegend = False
 
'2つ目の空のグラフを作成
' データ系列が設定されてしまった場合は削除
ActiveSheet.Shapes.AddChart.Chart.ChartType = xlColumnClustered
ActiveSheet.ChartObjects(2).Activate
ActiveChart.ChartArea.ClearContents
'チャートの凡例を削除
ActiveChart.HasLegend = False
 
 
 
'[C]データ系列数と各系列のデータ数を検出
p = Range("B2").End(xlDown).Row - 2
q = Range("B2").End(xlToRight).Column
 
 
 
'[C2]チャートのサイズを一括で設定する
    With ActiveSheet.ChartObjects
        .Height = 200 '高さの設定
        .Width = 600 '横幅の設定
    End With
 
 
'[C3]チャートの位置をずらす これをやらないと二つが重なる
    For k = 1 To ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(k).Left = ActiveSheet.ChartObjects(1).Left
        ActiveSheet.ChartObjects(k).Top = ActiveSheet.Range("B" & (k - 1) * 11 + 1).Top 'セルの高さを基準に11個分下にずらして2つ目のチャートを表示
    Next
 
 
'[D]データ系列数だけ繰り返し
For I = 1 To p
 
 
'[E]グラフにデータ系列を作成
    ActiveSheet.ChartObjects(1).Chart.SeriesCollection.NewSeries
    ActiveSheet.ChartObjects(2).Chart.SeriesCollection.NewSeries
 
 
 
'ループの2周目以降、iが2以降、前回描写したチャートを削除
    If I > 1 Then
        ActiveSheet.ChartObjects(1).Chart.SeriesCollection(deleteTarget).Delete
        ActiveSheet.ChartObjects(2).Chart.SeriesCollection(deleteTarget).Delete
    End If
 
'[F]データ系列の設定を行う
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
        .ChartType = xlLine '折れ線グラフに設定
        .XValues = Range(Cells(1, 4), Cells(1, q)) '横軸の値を設定
        .Values = Range(Cells(1 + I, 4), Cells(1 + I, q)) 'データを設定
        .Name = Cells(1 + I, 3) '系列名を設定
        .Format.Line.ForeColor.RGB = RGB(0, 255, 0) '色設定 緑
        .MarkerStyle = 2 'マーカーを表示(種類:1〜9)
        .MarkerSize = 8 'マーカーのサイズ
         'マーカーの背景色
        .MarkerBackgroundColor = RGB(255, 0, 0) '赤
         'マーカーの枠線色
        .MarkerForegroundColor = RGB(255, 0, 0) '赤
         
    End With
     
    '2個めの棒グラフの設定
    With ActiveSheet.ChartObjects(2).Chart.SeriesCollection(1)
        .ChartType = xlColumnClustered '棒グラフに設定
        .XValues = Range(Cells(1, 17), Cells(1, 17 + q)) '横軸の値を設定
        .Values = Range(Cells(1 + I, 17), Cells(1 + I, 17 + q)) 'データを設定
        '.Name = Cells(2 + i, 1) '系列名を設定
        .Format.Fill.ForeColor.RGB = RGB(0, 255, 0) '色設定 緑
         
    End With
 
'棒グラフの値がマイナスなら、色を赤に変える
    tmp = ActiveSheet.ChartObjects(2).Chart.SeriesCollection(1).Values
    For J = 1 To UBound(tmp)
        If tmp(J) < 0 Then
            With ActiveSheet.ChartObjects(2).Chart.SeriesCollection(1).Points(J)
                .Interior.ColorIndex = 3
                .Interior.Pattern = xlSolid
            End With
        End If
    Next J
 
 
     
    DoEvents
    DoEvents
    DoEvents
    DoEvents
 
 
 
'速度調整:PCをスリープ 他のアプリにも影響しそう?
' Sleep 2000
 
'速度調整:エクセルの処理のみを遅らせる(多分)
 
    Application.Wait [Now() + "00:00:00.01"]
         
 
Next I
 
End Sub
 
 

回答
投稿日時: 21/11/02 22:38:21
投稿者: simple

引用:
以下にソースを記載しますが、専用書式のデータでないと、うまく動かないと思います。

データの概要を示してください。
行番号、列番号がわかるようにしてください。
     A列     B     C     D
1行
2
3
4
(問題の本質を損なわない範囲で、できるだけ簡便なものが望ましいですね。)
動く動かないの問題ではなく、質問として成立していないと思います。
時間をかけて前提をあれこれ推測してくれる回答者は少なく、読んでもらえない可能性が高いですね。
 
引用:
@上の折れ線グラフと下の棒グラフで、項目名A〜Kは同じなので、上下のグラフで横の位置を合わせたい。

作成したグラフは、いくつの列を対象に描画しているか自分で確認してください。
  
引用:
A左に行くほど項目の間隔を狭くし、右側を広くしたい。(おそらく@ができれば応用できそう)
イメージ A,B,Cは1cm間隔で、IJKは3cm間隔。

おそらくそうした自由形式の項目幅は設定できない仕様ではないですか?
そもそもの必要性が理解できませんでした。余り聞いたことがない話です。
ご説明いただくと、他の回答者からコメントがあるかもしれません。
  
引用:
B棒グラフの項目名を2行にする
「A」を「東京都中央区」に変更した際に下記のように2行で表示したい
東京都
中央区

元データに改行コード(ALT+Enter)を入れるのではだめなんですか?
 
引用:
C棒グラフのy軸のメモリを ‐0.5 〜 +0.5 で固定したい。

ためしておりませんが、マクロ記録をとったらコードが得られるのでは?

投稿日時: 21/11/03 23:27:51
投稿者: match13

>simple様
 
再度のご教授頂き、ありがとうございます。
仕事で忙しく、週末まで、きちんと時間がとれないのですが、Bは、元データを改行すればいいのですね。
一点、解決しました。
 
 
週末、質問を分かりやすくなるように考え直します。
ご指摘、ありがとうございました。

回答
投稿日時: 21/11/04 21:31:18
投稿者: simple

一点だけ解決したそうですが、他もきちんと受け止めてください。
データを示す必要はあるにせよ、あなたの質問がまったく理解できていないわけではありません。
回答コメントを放置しないで頂きたい。
 
1.できあがったグラフが対象としている範囲を確認する必要がある旨書きましたが、
   はっきり書けば、間違っているのです。
   上下の対象とする列数が異なるので、項目がずれるのは当たり前です。
   (ご自分で気づいて欲しかったのです。)
2.項目幅は、各項目で自由に調整できるわけではないと思います(たぶん出来ない)。
   幅は均等で、項目目の大きさは、フォントの大きさなどで調整するという考え方を
   MS社はしているはずです。
4.手作業でできるはずです(軸の境界(最大値、最小値)、単位等の設定です。)
   それをマクロ記録すればコードは得られるはずです。
   ご自分でできることはご自分でやってください。

トピックに返信