Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7369 / 13644 ツリー ←次へ | 前へ→

【36413】任意の本数のグラフを作成 わいわい 06/3/30(木) 17:15 質問[未読]
【36414】Re:任意の本数のグラフを作成 Kein 06/3/30(木) 17:28 回答[未読]
【36419】Re:任意の本数のグラフを作成 わいわい 06/3/30(木) 18:01 お礼[未読]
【36727】グラフ描画のスピードUP わいわい 06/4/11(火) 10:21 質問[未読]
【36735】Re:グラフ描画のスピードUP Kein 06/4/11(火) 14:02 回答[未読]
【39537】ワークシート上グラフのデータラベル表示 わいわい 06/6/26(月) 13:39 質問[未読]

【36413】任意の本数のグラフを作成
質問  わいわい  - 06/3/30(木) 17:15 -

引用なし
パスワード
   いつもお世話になっております。
現在、5系統(種類?)で全部で約200本の曲線を1つのグラフにしようと考えています。各系統は、最小値、最大値を入力することで、その本数が変化します。手始めに一系統の描画ルーチンを作ろうと下記リストを作成したのですが、参照先指定のところで R[j]C44にjを反映させる方法が分かりません。マクロの記録では、" "で囲まれた文字列指定となるのですが、どうやればよろしいでしょうか?

Sub Macro2()

  Dim i As Integer
  Dim j As Integer
  i = 138
  j = 11
    
  ActiveSheet.ChartObjects("グラフ 5").Activate

  While i < 138 + (50)   '対象曲線が138番目から50本(仮)
    ActiveChart.SeriesCollection.NewSeries
    With ActiveChart.SeriesCollection(i)
      .XValues = "=DATA!R[j]C44:R[j]C45"
               ~~~~  ~~~~
      .Values = "=DATA!R[j]C46:R[j]C47"
               ~~~~  ~~~~
      .Name = DB
      .Border.ColorIndex = 1
      .Border.Weight = xlThin
      .Border.LineStyle = xlContinuous
    End With
    i = i + 1
    j = j + 1
  Wend
End Sub

あと、グラフ中の全曲線本数の取得方法が分かりましたらお教えください。
宜しく願いいたします。

【36414】Re:任意の本数のグラフを作成
回答  Kein  - 06/3/30(木) 17:28 -

引用なし
パスワード
   変数と文字列を繋ぐには & を挟みます。

"=DATA!R[" & j & "]C44:R[" & j & "]C45"

>グラフ中の全曲線本数

ActiveChart.SeriesCollection.Count

です。

【36419】Re:任意の本数のグラフを作成
お礼  わいわい  - 06/3/30(木) 18:01 -

引用なし
パスワード
   ▼Kein さん いつもいつもありがとうございます。
素早い回答ありがとうございます。
やはり
>"=DATA!R[" & j & "]C44:R[" & j & "]C45"
ですか。先ほど自分で作成した時には、
.Values = "=DATA!R"&j&"C46:R"&j&"C47"
とスペースを入れず(自動補正頼み)に、コンパイルエラーが出たため
違うのかと思い色々試していました。
作図は無事出来ました。(非常に遅いですが^^;)
>>    ActiveChart.SeriesCollection.NewSeries
>>    With ActiveChart.SeriesCollection(i)
辺りを工夫して、スピードアップを図ります。

>>グラフ中の全曲線本数
に対する回答ありがとうございます。
>ActiveChart.SeriesCollection.Count
これを用いて、効率の良い作図法を検討します。
本当にありがとうございました。

>変数と文字列を繋ぐには & を挟みます。
>
>"=DATA!R[" & j & "]C44:R[" & j & "]C45"
>
>>グラフ中の全曲線本数
>
>ActiveChart.SeriesCollection.Count
>
>です。

【36727】グラフ描画のスピードUP
質問  わいわい  - 06/4/11(火) 10:21 -

引用なし
パスワード
   いつもお世話になっております。
また、作図について教えていただきたくお願いします。
グラフの書き換え用に以下のマクロを作成しましたが、作業が重くどうにかしたいと思っています。具体的には※1でグラフをアクティブにせずに作図できるのか?次に※2で一度線を描いてから線種の書式設定をしている2度手間を整理できないかということになります。
また、削除マクロの※3で系統名が""の場合の処理をしていますが、実際にはエラーでとまってしまいます。
まとまりのない質問ですが、ご回答宜しくお願いします。

Sub 描画()
  Dim i As Integer
  Dim j As Integer
  Dim k As Double
  Dim l As Double
  Dim m As Double
  
  ActiveSheet.ChartObjects("グラフ 5").Activate ※1
  j = 10
  i = ActiveChart.SeriesCollection.Count + 1
  k = Worksheets("DATA").Range("F5").Value
  l = Worksheets("DATA").Range("F4").Value
  m = Worksheets("DATA").Range("E4").Value + k
  
  While m < l
    ActiveChart.SeriesCollection.NewSeries  ※2
    With ActiveChart.SeriesCollection(i)
      .XValues = "=DATA!R" & j & "C48:R" & j & "C49"
      .Values = "=DATA!R" & j & "C50:R" & j & "C51"
      .Name = "x_" & m
      .Border.ColorIndex = 1
      .Border.Weight = xlHairline
      .Border.LineStyle = xlContinuous
    End With
    i = i + 1
    j = j + 1
    m = m + k
  Wend
End Sub

Sub 削除()
  Dim i As Integer
  Dim j As Integer
  Dim l As String
    
  ActiveSheet.ChartObjects("グラフ 5").Activate
  i = ActiveChart.SeriesCollection.Count

  While i > 1
    If ActiveChart.SeriesCollection(i).Name = "" Then l = "xx" _
      Else l = Left(ActiveChart.SeriesCollection(i).Name, 2) ※3
    If l = "x_" Then ActiveChart.SeriesCollection(i).Delete
    i = i - 1
  Wend
End Sub

【36735】Re:グラフ描画のスピードUP
回答  Kein  - 06/4/11(火) 14:02 -

引用なし
パスワード
   >※1でグラフをアクティブにせずに作図
もちろん出来ます。ChartObject型の変数を用意します。同様に系列についても、
Serie型のオブジェクト変数にセットして使う書き方が出来ます。
>※2で一度線を描いてから線種の書式設定
書式設定は、デフォルトの設定では目的と違って、実現しないようなものについてのみ
行えば良いのです。マクロの自動記録をすると、デフォルトのままなのにも拘わらず、
いちいち全ての書式を再設定するようなコードが出てくるので、ヘルプで確認
しながら削除していきます。面倒なことは承知してますが、そのような編集の過程で、
知らなかったプロパティやメソッドを覚えられるので、デメリットばかりではない
のです。

Sub 描画()
  Dim Ch As ChartObject
  Dim j As Integer
  Dim k As Double, l As Double, m As Double
  
  Set Ch = ActiveSheet.ChartObjects("グラフ 5")
  j = 10
  With Worksheets("DATA")
    k = .Range("F5").Value
    l = .Range("F4").Value
    m = .Range("E4").Value + k
  End With
  Application.ScreenUpdating = False
  While m < l
    With Ch.Chart.SeriesCollection.NewSeries
      .XValues = "=DATA!R" & j & "C48:R" & j & "C49"
      .Values = "=DATA!R" & j & "C50:R" & j & "C51"
      .Name = "x_" & m
      .Border.Weight = xlHairline
    End With
    j = j + 1: m = m + k
  Wend
  Application.ScreenUpdating = True
  Set Ch = Nothing
End Sub

>※3で系統名が""の場合の処理をしていますが、実際にはエラー
If 〜 Then 〜 Else 〜 End If の条件分岐構文について、基礎の習得が出来て
いないようです。エラーの原因は、おそらくそれでしょう。

【39537】ワークシート上グラフのデータラベル表示
質問  わいわい  - 06/6/26(月) 13:39 -

引用なし
パスワード
   いつもお世話になります。前回の質問ではお礼も述べず放置してしまい申し訳ありませんでした。皆さんに回答して頂き、マクロの機能としては揃いましたので各動作の最適化、軽量化を進めようと思い見直すとやはり作図の部分がネックになります。中でも”データラベル”の表示作業が重いようなので、これについて教えてください。
やりたいことは、ある2点間を線で結び一方の点に任意の文字を表示させると言うものです。2点がそのつど位置が変わり、固定されない複数SETであるため、TextBox等では難しいと考えデータラベルを配置しTEXTを書き換えるという方法を選びました。しかし一度、線を挿入した後これを選択し書き換えると言う方法のため、(例では72本ですが)描画に非常に時間がかかります。
参考リストを掲載しますのでアドバイス宜しくお願いいたします。

Sub MakeDATA()'作図用のデータをSheet1に作ります。
  For i = 0 To 71
    With Worksheets("Sheet1")
      .Cells(4 + i, 1).Value = i * 5
      .Cells(4 + i, 2) = 0
      .Cells(4 + i, 3) = "=10*COS(PI()*RC[-2]/180)"
      .Cells(4 + i, 4) = 0
      .Cells(4 + i, 5) = "=10*sin(PI()*RC[-4]/180)"
    End With
  Next i
End Sub

Sub MakeCharts() '作図用のグラフ1をsheet1に作ります。
  Worksheets("Sheet1").Select
  Charts.Add
  With ActiveChart
    .ChartType = xlXYScatter
    .SetSourceData Source:=Sheets("Sheet1").Range("I12")
    .Location Where:=xlLocationAsObject, Name:="Sheet1"
  End With
End Sub

Sub 描画() '本題の作図作業を行います。
  Dim Ch As ChartObject
  Dim DL_Name As Variant
  Dim i As Integer, j As Integer, k As Integer, Line_Color As Integer
  Dim l As Double, m As Double
  
  Set Ch = ActiveSheet.ChartObjects("グラフ 1")

  Application.ScreenUpdating = False '画面更新停止し、ちょびっと高速化

  i = Ch.Chart.SeriesCollection.Count + 1
  j = 4
  k = Worksheets("Sheet1").Range("B4").End(xlDown).Row
  
  While j <= k
    With Ch.Chart.SeriesCollection.NewSeries
      .XValues = "=Sheet1!R" & j & "C2:R" & j & "C3"
      .Values = "=Sheet1!R" & j & "C4:R" & j & "C5"
      .Name = "No_" & j
      .Border.ColorIndex = 1
      .Border.Weight = xlHairline
      .Border.LineStyle = xlContinuous
    End With
'−−−直線の2番目の点にのみラベル表示(数値は任意:今回は角度)−−−
    Set DL_Name = Ch.Chart.SeriesCollection(i).Points(2).DataLabel
  
    Ch.Chart.SeriesCollection(i).Points(2).ApplyDataLabels Type:= _
        xlDataLabelsShowLabel, AutoText:=True, LegendKey:=False
    DL_Name.Characters.Text = Worksheets("Sheet1").Cells(j, 1).Value
    DL_Name.AutoScaleFont = False
    With DL_Name.Characters(Start:=1, Length:=4).Font
      .Name = "MS Pゴシック"
      .Size = 8
    End With
    i = i + 1: j = j + 1
'−−−−−−−−−−−−−−−−−−−−−−−−−−
  Wend
  
  Application.ScreenUpdating = True  '画面更新再開
  Set Ch = Nothing          'クリアー
  Set DL_Name = Nothing        'クリアー
End Sub

Sub 線消去()
  Dim Ch As ChartObject
  Dim i As Integer
    
  Set Ch = ActiveSheet.ChartObjects("グラフ 1")
  i = Ch.Chart.SeriesCollection.Count
  Application.ScreenUpdating = False
  While i > 0
    Ch.Chart.SeriesCollection(i).Delete
    i = i - 1
  Wend
  Application.ScreenUpdating = True
  Set Ch = Nothing
End Sub

>書式設定は、デフォルトの設定では目的と違って、実現しないようなものについて
>のみ行えば良いのです。
についてですが、例えば1〜50番目までは直線、51番目から破線と言うようなとき50番目の描画が終わった時点でデフォールト設定を破線へと変更できるものなのでしょうか?こちらについても解答お願いします。

7369 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free