いつも回答ありがとうございます。
似たような質問をしていますが、下記の記述の(b3.value!"$B$1").の箇所でエラーがかかりました。
.SetSourceData Source:=Range(b3.value!"$B$1").CurrentRegion
どのように変更したら上手く動作するのでしょうか？ｂ３は変数です。御指導の程宜しくお願い致します。
Sub グラフの作成()
Dim Date1 As Date 'グラフの始点の日付
Dim Date2 As Date 'グラフの終点の日付
Dim SName As String '商品名
Dim b1 As Variant 'グラフの始点のセル番号
Dim b2 As Variant 'グラフの終点のセル番号
Dim b3 As Variant '対象の商品名のセル番号
Dim d1 As Variant 'b1と違う列のセル番号
Dim d2 As Variant 'b2と違う列のセル番号
Dim d3 As Variant 'b3と違う列のセル番号
With Worksheets("集計用")
s1:
Date1 = Application.InputBox("最初の日付を2012/12/1のように入力してください。")
If Date1 = 0 Then
MsgBox "キャンセルされました。", vbOKOnly
Exit Sub
End If
Set b1 = .Columns("B").Find(Date1, , xlValues, 1)
If b1 Is Nothing Then
If MsgBox("入力した日付が見当たりません。" & vbNewLine & _
"再度入力しますか？", vbYesNo) = vbYes Then
GoTo s1
Else
MsgBox "処理を中止しました", vbOKOnly
Exit Sub
End If
End If
d1 = b1.Row
s2:
Date2 = Application.InputBox("最初の日付を2012/12/31のように入力してください。")
If Date1 = 0 Then
MsgBox "キャンセルされました。", vbOKOnly
Exit Sub
End If
Set b2 = .Columns("B").Find(Date2, , xlValues, 1)
If b2 Is Nothing Then
If MsgBox("入力した日付が見当たりません。" & vbNewLine & _
"再度入力しますか？", vbYesNo) = vbYes Then
GoTo s2
Else
MsgBox "処理を中止しました", vbOKOnly
Exit Sub
End If
End If
d2 = b2.Row
s3:
SName = Application.InputBox("商品名を入力して下さい。")
If SName = "False" Then
MsgBox "キャンセルされました。", vbOKOnly
Exit Sub
End If
Set b3 = .Rows("3").Find(SName, , xlValues, 1)
If b3 Is Nothing Then
If MsgBox("入力した商品名が見当たりません。" & vbNewLine & _
"再度入力しますか？", vbYesNo) = vbYes Then
GoTo s3
Else
MsgBox "処理を中止しました", vbOKOnly
Exit Sub
End If
End If
d3 = b3.Column
Worksheets.Add After:=Worksheets("集計用")
ActiveSheet.Name = b3.Value
.Activate
.Range(b1, b2).Copy _
Destination:=Worksheets(b3.Value).Range("B2")
.Activate
.Range(Cells(d1, d3), Cells(d2, d3)).Copy _
Destination:=Worksheets(b3.Value).Range("C2")
With Worksheets(b3.Value).Range("D2:D" & Range("C65536").End(xlUp).Row)
.Formula = "=SUM(C2,D1)"
.Value = .Value
End With
End With
Charts.Add
With ActiveChart
.ChartType = xlColumnClustered
.SetSourceData Source:=Range(b3.value!$B$1").CurrentRegion
With .Axes(xlValue)
.MaximumScale = 10
.MajorUnit = 1
End With
.Location Where:=xlLocationAsObject, Name:=b3.Value
End With
End Sub
お礼
すみません。基本的な記述ミスでした。全然理解できてないようです。まだまだですね。御指摘ありがとうございました。