Excel VBA質問箱 IV

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

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


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

【60794】グラフの挿入をVBAで行う アル 09/3/15(日) 16:29 質問[未読]
【60795】Re:グラフの挿入をVBAで行う kanabun 09/3/15(日) 19:48 発言[未読]
【60796】Re:グラフの挿入をVBAで行う kanabun 09/3/15(日) 21:21 発言[未読]
【60805】Re:ありがとうございます。恥ずかしながら… アル 09/3/16(月) 12:44 質問[未読]
【60806】Re:ありがとうございます。恥ずかしながら… kanabun 09/3/16(月) 14:21 発言[未読]
【60815】おかげさまで出来ました。 アル 09/3/16(月) 19:41 お礼[未読]
【60822】いったん締めた後に恐縮ですが… アル 09/3/17(火) 5:51 質問[未読]
【60823】Re:いったん締めた後に恐縮ですが… kanabun 09/3/17(火) 8:47 発言[未読]
【60845】Re:いったん締めた後に恐縮ですが… アル 09/3/17(火) 19:36 お礼[未読]

【60794】グラフの挿入をVBAで行う
質問  アル  - 09/3/15(日) 16:29 -

引用なし
パスワード
   500行〜1000行のデータのグラフの挿入をVBAで行いたいと考えています。
下は「新しいマクロの記録」で得たコードです。(B列が横軸、C列が縦軸)

Sub GURAFU01()
  Charts.Add
  ActiveChart.ChartType = xlXYScatterSmooth
  ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range( "B2:B600,C2:C600"), PlotBy:=xlColumns
  ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
End Sub

グラフ横軸の範囲は、上のコードでは2行目〜600行目までですが、その上限を
A列に"0"が初めて3つ以上並ぶまでにしたいのです。

例)
A    B      C
…   …     …
9    800    110
3    801    150
1    802    190
0    803    260
0    804    300
0    805    360 (B列横軸の上限ここまで)
0    806    390

A列に0が初めて3つ以上並んだ行を取得して上のコードに反映させるには
どうしたらいいでしょうか?

【60795】Re:グラフの挿入をVBAで行う
発言  kanabun  - 09/3/15(日) 19:48 -

引用なし
パスワード
   ▼アル さん:

こんばんは。

>A列に"0"が初めて3つ以上並ぶまでにしたいのです。
>
>例)
>A    B      C
>…   …     …
>9    800    110
>3    801    150
>1    802    190
>0    803    260
>0    804    300
>0    805    360 (B列横軸の上限ここまで)
>0    806    390
>
>A列に0が初めて3つ以上並んだ行を取得して上のコードに反映させるには

A列にあるのは 1桁の数字ばかりですか?
それとも 2桁とか あるんでしょうか?

Dim r As Range
Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))
MsgBox Join(Application.Transpose(r))

としたとき、どんな文字列となりますか?

【60796】Re:グラフの挿入をVBAで行う
発言  kanabun  - 09/3/15(日) 21:21 -

引用なし
パスワード
   ま、あくまでひとつの考え方ですが、
A列の数字がすべて一桁だとすると、
A列をTransposeしてよこ1行にした値を Joinすれば A列データを結合した
単一文字列となります。
たとえば
 A列
2 9
3 8
4 1
5 4
6 0
7 7
8 0
9 0
10 0

とあるとき、以下を実行してみてください。

Sub Try1()
 Dim r As Range
 Dim ss As String
 Dim i As Long
 
 Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))
 ss = Join(Application.Transpose(r), "")
 MsgBox ss ' ------->    "981407000"
 i = InStr(ss, "000")   
 If i > 0 Then
   MsgBox "範囲の " & i & " 番目から 0 が3つ連続しています"
 Else
   MsgBox "A列に 0 が3つ連続するデータの並びはありません"
   Exit Sub
 End If
 
End Sub

'2桁とかもあるばあいは この考え方の応用で、各セルから先頭1文字だけを
抽出して 上と同じように "000"を探します。

Sub Try2()
 Dim r As Range
 Dim ss As String
 Dim i As Long
 
 Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))
 ss = Join(Application.Transpose(Application.Replace(r, 2, 10, "")), "")
 MsgBox ss
 i = InStr(ss, "000")
 If i > 0 Then
   MsgBox "範囲の " & i & " 番目から 0 が3つ連続しています"
 Else
   MsgBox "A列に 0 が3つ連続するデータの並びはありません"
   Exit Sub
 End If
 
End Sub

さて、[A2]セル以降を結合した文字列の i番目に "000"が見つかったとすれば、
グラフの元データ範囲は
 [A2].Resize(i+2)
の一つ右ともうひとつ右の範囲をUnion したものということになりますので、
こんな感じで埋め込みグラフにSourceData範囲を指定できます。

(↓グラフの元データ範囲と グラフを描画するシートは同じシートのとき)
Sub Try3()
  Dim r As Range
  Dim ss As String
  Dim i As Long
  Dim c As Range
  
  With Worksheets("Sheet1")
    Set r = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
    ss = Join(Application.Transpose(r), "")
    i = InStr(ss, "000")
    If i > 0 Then
      MsgBox ss & vbCr _
      & "範囲の " & i & " 番目から 0 が3つ連続しています"
    Else
      MsgBox "A列に 0 が3つ連続するデータの並びはありません"
      Exit Sub
    End If
    With r.Resize(i + 2)
      Set r = Union(.Offset(, 1), .Offset(, 2))
    End With
    
    Set c = .Range("D8").Resize(15, 5)
    With .ChartObjects.Add(c.Left, c.Top, c.Width, c.Height).Chart
      .ChartType = xlXYScatterSmooth
      .SetSourceData Source:=r, PlotBy:=xlColumns
    End With
  End With
End Sub

補足
> Charts.Add
は グラフシートを作成するコードです。
いま作りたいのは 埋め込みグラフですから、そのばあいは
上の例のように、
>  With .ChartObjects.Add(c.Left, c.Top, c.Width, c.Height).Chart

グラフを描画する場所とサイズを指定して 埋め込みグラフ(ChartObjects)を
Add したほうが効率よいと思います。

【60805】Re:ありがとうございます。恥ずかしなが...
質問  アル  - 09/3/16(月) 12:44 -

引用なし
パスワード
   ご丁寧な回答大変ありがとうございます。
恥ずかしながら、不勉強のためコードの理解に手こずっています。
Try2 と Try3の組み合わせ方が今ひとつわかりません。
さらに、
下のような表を当てはめると、
私が意図したプロットでは、A列で0が3つ続くところ(=B列14)、
その14を横軸の最大値としてC軸が縦軸のグラフを作成したいのですが、
ご教授いただいたTry3では横軸が表の最後の23までプロットされてしまいます。

Try2のメッセージボックスでは、たしかに14を取得しているのですが…

図々しいですが差し支えなければお教え頂きたいです。

 A   B     C         
111    0    36    
112    1    38    
113    2    45    
114    3    42    
115    4    41    
116    5    46    
117    6    49    
118    7    39    
119    8    40    
120    9    40    
121    10    15    
122    11    12    
 0    12    33    
 0    13    36    
 0    14    25    
 0    15    29    
 0    16    36    
 0   17    30     
 0    18    33    
 0    19    36    
 0    20    25    
 0    21    29    
 0    22    36    
 0   23    30

【60806】Re:ありがとうございます。恥ずかしなが...
発言  kanabun  - 09/3/16(月) 14:21 -

引用なし
パスワード
   ▼アル さん:

>恥ずかしながら、不勉強のためコードの理解に手こずっています。
>Try2 と Try3の組み合わせ方が今ひとつわかりません。
>さらに、
>下のような表を当てはめると、
>私が意図したプロットでは、A列で0が3つ続くところ(=B列14)、
>その14を横軸の最大値としてC軸が縦軸のグラフを作成したいのですが、
>ご教授いただいたTry3では横軸が表の最後の23までプロットされてしまいます。
>
>Try2のメッセージボックスでは、たしかに14を取得しているのですが…

それはこういうことです。
Sub Try3() の "000"位置の判定には Sub Try1()の単純な考え方のほう、
つまり、A列の数字は必ず「一桁」という条件で成り立つ方法で判断し
ているから、必ずしも一桁でないときは 文字列上で "000"のある位置
と、セル上での行数が一致しません。

> A   B     C         
>111    0    36    
>112    1    38    
>113    2    45    
>114    3    42    
>115    4    41    
>116    5    46    
>117    6    49    
>118    7    39    
>119    8    40    
>120    9    40    
>121    10    15    
>122    11    12    
> 0    12    33    
> 0    13    36    
> 0    14    25    
> 0    15    29    
> 0    16    36    

こういうA列データを Try1()で TransposeしてJoinしますと
> ss = Join(Application.Transpose(r), "")
"11111211311411511611711811912012112200000"
という文字列となり、この文字列から "000"を検索すれば、
37番目から"000"があることになります。
Try2()で 先頭の数字1文字を連結すれば、
同じデータは
"111111111111000000000000" という文字列となり、このばあいは
13番目から"000"が始まっています、
ということになります。
ですから、解決策は簡単で、

>    Set r = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
>    ss = Join(Application.Transpose(r), "")
Try1()条件でかいてあるこの行を
    ss = Join(Application.Transpose( _
       Application.Replace(r, 2, 10, "")), "")

のように Try2()方式に改めれば、すべて解決となるはずです。

【60815】おかげさまで出来ました。
お礼  アル  - 09/3/16(月) 19:41 -

引用なし
パスワード
   目的のマクロが組めました。
どうもありがとうございました。

【60822】いったん締めた後に恐縮ですが…
質問  アル  - 09/3/17(火) 5:51 -

引用なし
パスワード
   グラフは別シートに表示したいのですが、
Sheet1の"D8"にできたグラフを
Sheet2の"B3"に表示(移動?)させるには
どうしたらよいでしょうか?(または最初からSheet2の"B3"に表示)

【60823】Re:いったん締めた後に恐縮ですが…
発言  kanabun  - 09/3/17(火) 8:47 -

引用なし
パスワード
   ▼アル さん:
>グラフは別シートに表示したいのですが、

シートが変わるなら、
(1)元データ範囲の取得部分と
(2)埋め込みグラフの作成 部分とを別々の With 句にすればいいです。

Sub Try4() '元データシート と グラフ出力シートが別
  Dim r As Range
  Dim ss As String
  Dim i As Long
  Dim c As Range
  
  '(1)元データ範囲を Range変数r にセットする
  With Worksheets("Sheet1")
    Set r = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
    'ss = Join(Application.Transpose(r), "")
    ss = Join(Application.Transpose( _
         Application.Replace(r, 2, 10, "")), "")
    i = InStr(ss, "000")
    If i > 0 Then
      MsgBox ss & vbCr _
      & "範囲の " & i & " 番目から 0 が3つ連続しています"
    Else
      MsgBox "A列に 0 が3つ連続するデータの並びはありません"
      Exit Sub
    End If
    With r.Resize(i + 2)
      Set r = Union(.Offset(, 1), .Offset(, 2))
    End With
  End With
    
  '(2)位置とサイズを指定して 埋め込みグラフの描画
  With Worksheets("Sheet2")
    Set c = .Range("B3").Resize(15, 5) '<--- サイズは適当です
    With .ChartObjects.Add(c.Left, c.Top, c.Width, c.Height).Chart
      .ChartType = xlXYScatterSmooth
      .SetSourceData Source:=r, PlotBy:=xlColumns
    End With
  End With
End Sub

【60845】Re:いったん締めた後に恐縮ですが…
お礼  アル  - 09/3/17(火) 19:36 -

引用なし
パスワード
   遅くなりました。
出来ました。どうもありがとうございました。

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