• ベストアンサー
  • 困ってます

エクセル マクロ チェックボックス

sheet1にチェックボックスが3つあり、マクロを実行するコマンドボタンが1つあります。 チェックボックスにレ点を入れることにより、sheet4のデータからsheet2にグラフを作成しようと考えてますが、エラーが出てしまい解決できません。 どのように訂正したらいいのか教えて頂けないでしょうか。 Private Sub CommandButton1_Click() Dim GraphRange As String Dim Graph As ChartObject Dim lastRow As Long Set Graph = Sheets("sheet2").ChartObjects.Add(150, 27, 350, 200) lastRow = Sheets("sheet4").Range("A" & Rows.Count).End(xlUp).Row GraphRange = Sheets("sheet4").Range(Cells(1, 1), Cells(lastRow, 1)).Value If Sheets("sheet1").CheckBox1.Value = True Then 'CheckBox1にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 2), Cells(lastRow, 2)).Value End If If Sheets("sheet1").CheckBox2.Value = True Then 'CheckBox2にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 3), Cells(lastRow, 3)).Value End If If CheckBox3.Value = True Then 'CheckBox3にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 4), Cells(lastRow, 4)).Value End If Graph.Chart.ChartWizard Source:=Sheets("sheet4").Range(GraphRange).Value, _ Gallery:=xlLine, Format:=1, PlotBy:=xlColumns, _ CategoryLabels:=1, SeriesLabels:=1, HasLegend:=True End Sub

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数374
  • ありがとう数1

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.1
  • keithin
  • ベストアンサー率66% (5278/7939)

ふむ。。chartwizardでグラフを描かせてみるなら、だいたいこんなカンジでしょうか。 private sub CommandButton1_Click()  dim myGraph as chartobject  dim myRange as string  dim LastRow as long  lastrow = worksheets("Sheet4").range("A65536").end(xlup).row  set mygraph = worksheets("Sheet2").chartobjects.add(150, 27, 350, 200)  if worksheets("Sheet1").checkbox1 then myrange = myrange & ",$B$1:$B$" & lastrow  if worksheets("Sheet1").checkbox2 then myrange = myrange & ",$C$1:$C$" & lastrow  if worksheets("Sheet1").checkbox3 then myrange = myrange & ",$D$1:$D$" & lastrow  if myrange = "" then   msgbox "SELECT CHECKBOX"   exit sub  end if  myrange = "$A$1:$A$" & lastrow & myrange  mygraph.chart.chartwizard source:=worksheets("Sheet4").range(myrange), _   Gallery:=xlLine, Format:=1, PlotBy:=xlColumns, _   CategoryLabels:=1, SeriesLabels:=1, HasLegend:=True end sub #補足 >どのように訂正したらいいのか教えて頂けないでしょうか。 ●間違い チェックボックスの1,2,3がチェックされていると、最後のチェックボックスの該当列「だけ」がグラフの対象になります。それではチェックボックスを使う意味がありません ●間違い あなたのgraphrangeにvalueをセットしてもダメです ●間違い chartwizardのsource引数に与える内容が間違っています ●間違い sheets("Sheet4").range(cells, cells)の書き振りはすべて間違っています 初心者さんが必ず一度は引っかかる間違いですが sheets("Sheet4").range(sheets("Sheet4").cells, sheets("Sheet4").cells) のように丁寧にシートから修飾しないと間違えます

共感・感謝の気持ちを伝えよう!

質問者からのお礼

いつもご回答ありがとうございます。 間違い箇所のご説明もあり大変勉強になります。 今後ともご指導のほどよろしくお願い致します。

関連するQ&A

  • エクセル マクロ:チェックボックス コピー

    教えてください。 sheet1にデータがあり sheet2にチェックボックスとコマンドボタンがあります。 チェックボックスにレ点を入れ、コマンドボタンを押すと sheet1の該当する列をコピーして、sheet3に貼り付ける マクロを作ろうと思ってますがうまくいきません。 下記のマクロを使えるように手直ししていただけないでしょうか。 よろしくお願い致します。 Private Sub CommandButton1_Click() Dim myrange As String Dim rmax As Long rmax = Sheets("sheet1").Range("A2").End(xlDown).Row With Sheets("sheet2") If .CheckBox1 Then myrange = myrange & ",$B$1:$B$" & rmax If .CheckBox2 Then myrange = myrange & ",$C$1:$C$" & rmax If .CheckBox3 Then myrange = myrange & ",$D$1:$D$" & rmax End With If myrange = "" Then MsgBox "チェックしてください" Exit Sub End If myrange = "$A$2:$A$" & rmax & myrange Sheets("sheet1").Range(myrange).Copy Sheets("sheet3").Range("A1").PasteSpecial xlPasteValues Application.CutCopyMode = False Sheets("sheet3").Select End Sub

  • エクセル マクロ:チェックボックス コピー2

    昨日質問し、解決したと思ったのですが、データ量とチェックボックスの数を増やしたら エラーが出てしまいました。解決策を教えてください。 sheet1にはデータがあり行数は25000です。(行数は変動で行数MAXだったりもします) sheet2にはチェックボックス20個とコマンドボタンがあります。 下記のマクロでは17個までチェックしてもコピー出来ましたが、18個目からエラーが出ました。 よろしくお願い致します。 Private Sub CommandButton1_Click() Dim myrange As String Dim rmax As Long rmax = Sheets("sheet1").Range("B1").End(xlDown).Row With Sheets("sheet2") If .CheckBox1 Then myrange = myrange & ",$B$1:$B$" & rmax If .CheckBox2 Then myrange = myrange & ",$C$1:$C$" & rmax If .CheckBox3 Then myrange = myrange & ",$D$1:$D$" & rmax If .CheckBox4 Then myrange = myrange & ",$E$1:$E$" & rmax If .CheckBox5 Then myrange = myrange & ",$F$1:$F$" & rmax If .CheckBox6 Then myrange = myrange & ",$G$1:$G$" & rmax If .CheckBox7 Then myrange = myrange & ",$H$1:$H$" & rmax If .CheckBox8 Then myrange = myrange & ",$I$1:$I$" & rmax If .CheckBox9 Then myrange = myrange & ",$J$1:$J$" & rmax If .CheckBox10 Then myrange = myrange & ",$K$1:$K$" & rmax If .CheckBox11 Then myrange = myrange & ",$L$1:$L$" & rmax If .CheckBox12 Then myrange = myrange & ",$M$1:$M$" & rmax If .CheckBox13 Then myrange = myrange & ",$N$1:$N$" & rmax If .CheckBox14 Then myrange = myrange & ",$O$1:$O$" & rmax If .CheckBox15 Then myrange = myrange & ",$P$1:$P$" & rmax If .CheckBox16 Then myrange = myrange & ",$Q$1:$Q$" & rmax If .CheckBox17 Then myrange = myrange & ",$R$1:$R$" & rmax If .CheckBox18 Then myrange = myrange & ",$S$1:$S$" & rmax If .CheckBox19 Then myrange = myrange & ",$T$1:$T$" & rmax If .CheckBox20 Then myrange = myrange & ",$U$1:$U$" & rmax End With If myrange = "" Then MsgBox "チェックしてください" Exit Sub End If myrange = "$A$1:$A$" & rmax & myrange Sheets("sheet1").Range(myrange).Copy Sheets("sheet3").Range("A1").PasteSpecial xlPasteValues Sheets("sheet3").Select End Sub

  • エクセル チェックボックスの解除について(VBA)

    YES/NOを入力させる為の下記のVBAにおいて、チェックボックス1をチェックすると、アの部分でチェックボックス2の解除を行う関係で?、シート上でチェックボックス2を操作していないのにもかかわらず、勝手にCheckBox2_Click()に入り、命令文イを実行してしまいます。 ただ単にSub CheckBox1_Click()のルーチンの最後までの処理で終わりたいのですが、どうしたらよいのでしょうか。 Private Sub CheckBox1_Click() If CheckBox1 = True Then Sheets("sheet1").Range("A1") = 1 Sheets("sheet1").Range("A2") = 0 CheckBox2 = False・・・ア Else Sheets("sheet1").Range("A1") = "" End If End Sub Private Sub CheckBox2_Click() If CheckBox2 = True Then Sheets("sheet1").Range("A1") = 0 Sheets("sheet1").Range("A2") = 1 CheckBox1 = False Else Sheets("sheet1").Range("A2") = ""・・・イ End If End Sub

  • excel;マクロ;表現をもっと縮小したい

    質問します。下記のようなモジュールで中に同様の数字のみが順に変わるブロック繰り返しが多数あるのですが、もっと簡略化した表現 が可能でしょうか。よろしくお願いします。 Sub usb_count() d = Range("A65536").End(xlUp).Row j = 3 For i = 2 To d Select Case Cells(i, "B") Case Sheets("sheet2").Cells(4, "A") Sheets("sheet2").Cells(4, "B").Value = Sheets("sheet2").Cells(4, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(4, "C").Value = Sheets("sheet2").Cells(4, "C").Value + 1 Else Sheets("sheet2").Cells(4, "D").Value = Sheets("sheet2").Cells(4, "D").Value + 1 ' End If ‘------------------------------------------------------------------------------------------------------------------------------------ Case Sheets("sheet2").Cells(5, "A") Sheets("sheet2").Cells(5, "B").Value = Sheets("sheet2").Cells(5, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(5, "C").Value = Sheets("sheet2").Cells(5, "C").Value + 1 Else Sheets("sheet2").Cells(5, "D").Value = Sheets("sheet2").Cells(5, "D").Value + 1 End If ‘----------------------------------------- ‘以下上記の‘-----------から‘-----------で囲まれたブロックが( )内の数字が6から20まで繰り返され続く が略す End Select Next i End Su

  • エクセル マクロ 抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数=値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • マクロのソートについて

    A列:E列のセルデータがあって、空欄を省いて、コピペでるようにしたのでが、新たに、D列を最初にソート、後からB列・C列を連動させてソートしたいのですが、うまく処理できません。ご教授願えませんか。Sheets("ZZZZZZZ")のデータは1行おきのようなデータです。コピペまではできていますが、その後のソートについてお願いします。 Sub Macro1() Application.ScreenUpdating = False Dim Rng As Range Dim LastRow As Long '●ここをだけ"B2:B100"指定する For Each Rng In Sheets("ZZZZZZZ").Range("B2:B100") If Rng.Value <> "" Then LastRow = Sheets("QQQQQQQQ").Cells(Rows.Count, "B").End(xlUp).Row Sheets("QQQQQQQQ").Cells(LastRow + 1, "B").Resize(1, 3).Value = Rng.Resize(1, 3).Value End If Next Rng Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

  • エクセル マクロ:チェックボックス コピー3

    前回、質問した件で、追加で質問させていただきます。 前回の質問は、sheet2のチェックボックスによって、sheet1の列をコピーして、sheet3にペーストするという内容でした。 keithin様からご回答いただき問題は解決しましたが、修正を加えなくてはならなくなりました。 sheet2のチェックボックスによってsheet1の列とsheet4の列をコピーして、sheet3にペーストしようと頑張りましたが、解決できそうにありません。 尚、sheet1とsheet4の行数は同じで、sheet1とsheet4のA列は同じ内容なので必要ありません。 下記が前回のベストアンサーです。 private sub CommandButton1_Click()  dim res as range  dim rmax as long  dim i as integer  dim flg as boolean  rmax = worksheets("Sheet1").range("B1").end(xldown).row  set res = worksheets("Sheet1").range("A1:A" & rmax)  for i = 1 to 20   if worksheets("Sheet2").oleobjects("CheckBox" & i).object.value then    set res = union(res, worksheets("Sheet1").range("A1:A" & rmax).offset(0, i))    flg = true   end if  next i  if not flg then  msgbox "NO CHECK"  exit sub  end if  res.copy  worksheets("Sheet3").range("A1").pastespecial paste:=xlpastevalues  worksheets("Sheet3").select end sub keithin様 無断で借用させていただきました。申し訳ございません。

  • エクセル2003マクロの再編集

    Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Cells(行2, 3).Value = Abs(Sheets("Sheet2").Cells(行2, 3).Value) If Range("A" & 行1).Value = "BBBB1" Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub を編集したいのですが全然図りません ご指導お願いします 元データ AAAA5 9601  950 BBBB1 9660  150 ASAS9 9654  -50 AXCW5 9603  1375 以下の用にマクロで変換する用に出来たのですが 【1】 BBBB1だけではなくAAAA5も対処になったときの 追加方法です 元データは一切変更が出来ません ※フォントの変更も不可です 【2】 元データと変換後データがSheet1からSheet2になっていますが Sheet1の元は範囲はA1~C400で変換後をSheet1E1~G400にしたいのです AAAA5 9601  950  BBBB1-1 9660  150  BBBB1-2 9660  150 ASAS9 9654  50 AXCW5 9603  1375

  • マクロエラー処理

    下記のマクロを実行すると、If (.Range のところでコンパイルエラー参照が不正または不完全です。というメッセージが出るのですが、どこを修正すればよいのでしょうか 教えてください。 Sub 再表示1() Dim SheetName As String Dim i As Integer Dim LastRow As Integer Dim rng As Range LastRow = 3000 '最終行の番号 Sheets("ACT").Select For i = 6 To LastRow If (.Range("D" & i) = "A310" Or .Range("D" & i) = "A505") And .Range("V" & i) < 0 Then .Cells(i, "W").Resize(1, 3).ClearContents End If Next Stop End With End Sub

  • 二つのマクロで一気に処理したい

    以下のようなことができるのかお伺い致します。よろしくお願い致します。  やりたいこと   ※ 前提として、sheet1にすでにA列に通し番号で奇数の数字が入っている。    1.sheet1からsheet2へコピペーストする。しかし、A列からO列のすべてにデータがあった場合のみコピー貼り付けさせたい。     (前提で示したように、A列に通し番号で奇数の数字が入っていて、A列のみ数字があり、以外が空欄の行があるため)    2.下記のコピー貼り付けのコードと重複削除のコードを合体させて、一つの処理で動かしたい。 Sub コピー貼り付けつけ()  'コピー貼り付けつけのコード Dim lastRow As Long 'Sheet1のA3から最終行までをコピー With Sheets("sheet1") .Range("A3:O" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy End With 'Sheet2のA列の最終行の次の行に貼付け Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Application.CutCopyMode = False End Sub Sub 重複データを一括削除する() ' Macro1 Macro Dim i As Long, lastRow As Long, myRng As Range LastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow - 1 If WorksheetFunction.CountIf(Range(Cells(i + 1, "O"), Cells(lastRow, "O")), Cells(i, "O")) > 0 Then If myRng Is Nothing Then Set myRng = Cells(i, "O") Else Set myRng = Union(myRng, Cells(i, "O")) End If End If Next i If Not myRng Is Nothing Then myRng.EntireRow.Delete End If End Sub