[[20130607140626]] 『グラフ範囲の取得』(ロン) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『グラフ範囲の取得』(ロン)

毎回、お世話になっています。
新規でうまく質問開始できなかったので、再登録させていただきます。

C列:日付
D列:ロットNo.
E列:生産数

この情報を日付から50または100ロット(変数:n)で遡って
折れ線グラフを作成したいのですが、日付を検索し、その行番号を
反映させたグラフ範囲がうまく取得できません。

Sub グラフ作成処理()

Dim LastData, r, n As Integer
Dim Target As Range

    LastData = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Cells.Count).Row

    n = ActiveSheet.Range("B1").Value   '-----表示するロット数
For r = 2 To LastData 

    If Cells(r, 3).Value = Range("A1").Value Then 
        Range("A20").Value = r   '----確認のため行番号を書き出しています
ココ?→ Set Target = ActiveSheet.Range(Cells(r - n, 4), Cells(r, 5)) 

        Else
        r = r + 1
    End If
Next
'グラフシート作成 

    Charts.Add
'グラフ種類指定(折れ線グラフ) 

    ActiveChart.ChartType = xlLineMarkers

        With ActiveChart
            .SetSourceData Source:=Target, PlotBy:=xlColumns
            .HasTitle = True
        End With
End Sub 

すみませんが教えて下さい。
よろしくお願いします。

Excel2007使用


違うかもしれませんが、叩き台としてどうぞ(マナ)

 Sub test()
    Dim LastData As Long, r As Long, n As Long, i As Long
    Dim Target As Range

    LastData = Range("C" & Rows.Count).End(xlUp).Row
    r = WorksheetFunction.Match(Range("A1").Value2, Range("C2:C" & LastData), 0)
    Range("A20").Value = r

    n = Range("B1").Value

    If r - n + 1 < 1 Then MsgBox "指定値が不適切です": Exit Sub

    Set Target = Range("D1:E1").Resize(n).Offset(r - n + 1)

    With Charts.Add
        .ChartType = xlLineMarkers
        .HasTitle = True
        .ChartTitle.Text = "test"
        For i = .SeriesCollection.Count To 1 Step -1
              .SeriesCollection(i).Delete
        Next
        With .SeriesCollection.NewSeries
            .XValues = Target.Columns(1)
            .Values = Target.Columns(2)
        End With
    End With

 End Sub

今見ると、元データ範囲の求め方がわかりにくかったです。ロンさんのわかりやすいように修正してみてください(マナ)

rが間違っていたので修正です(マナ)

Sub test2()

    Dim LastData As Long, r As Long, n As Long, i As Long
    Dim Target As Range

    LastData = Range("C" & Rows.Count).End(xlUp).Row
    r = WorksheetFunction.Match(Range("A1").Value2, Range("C1:C" & LastData), 0)
    Range("A20").Value = r

    n = Range("B1").Value

    If r - n < 1 Then MsgBox "指定値が不適切です": Exit Sub

    Set Target = Range("D1:E1").Resize(n).Offset(r).Offset(-n)

    With Charts.Add
        .ChartType = xlLineMarkers
        .HasTitle = True
        .ChartTitle.Text = "test"
        For i = .SeriesCollection.Count To 1 Step -1
              .SeriesCollection(i).Delete
        Next
        With .SeriesCollection.NewSeries
            .XValues = Target.Columns(1)
            .Values = Target.Columns(2)
        End With
    End With

End Sub


 もともとのコードは
 >    For r = 2 To LastRow '-----C列を 2行目から最終行までループ
 >        If Cells(r, 3).Value = Range("A1").Value Then
 >            Set Target = ActiveSheet.Range(Cells(r - n, 4), Cells(r, 5)) '◆ココ?
 >        Else
 >            r = r + 1  '←◆不要です
 >        End If
 >    Next
 というコードになっているので、たとえば [C2]が [A1]と一致しないと、次は 3行目でなく
 4行目[C4] を検索するようになっているので、検索値の日付が見つからないことがある、
 ということですね。
 (マナ)さんのコード案にあるように、日付の検索は Match関数がベストだと思うけど、
 あえて元のコードを修正する形でFor〜Nextで検索するようにすると、
 こんな感じかな?

 Sub グラフ作成処理2()
  Dim LastRow&, r&, n As Integer  'VBAでは 変数それぞれにデータ型を指定します
  Dim Target As Range

    LastRow = Cells(Rows.Count, 3).End(xlUp).Row
    n = Range("B1").Value   '-----表示するロット数
    For r = 2 To LastRow               '-----C列を 2行目から最終行までループ
        If Cells(r, 3).Value = Range("A1").Value Then
            If r - n > 1 Then
                Set Target = Cells(r - n, 4).Resize(n, 2)
                Exit For      '●みつかれば ループを抜けます
            Else
                MsgBox "検索日付は" & r & "行目にあり" & vbCr _
                      & "早すぎて " & n & "行表示できません"
                Exit Sub
            End If
        End If
    Next

    'グラフシート作成
    With Charts.Add
        .ChartType = xlLineMarkers 'グラフ種類指定(折れ線グラフ)
        .SetSourceData Source:=Target, PlotBy:=xlColumns
        .HasTitle = True
    End With
 End Sub

 (kanabun)


マナさん、kanabunさん

アドバイス、ありがとうございました!
お二人のアドバイスを参考にして、もう一度自分の書いたコードを見直してみます。

今後ともよろしくお願いします。

ロン


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.