オートフィルタ適用後のマクロ実行

このQ&Aのポイント
  • オートフィルター適用後のグラフに対してマクロを実行する方法について教えてください。
  • Excelのグラフのプロットからデータを見つける方法について、以前の質問記事で解説されていましたが、オートフィルター適用後のグラフに対してはうまく実行できないようです。修正方法を教えてください。
  • オートフィルター適用後のグラフに対してマクロを実行するためのVBAコードの例を教えてください。
回答を見る
  • ベストアンサー

オートフィルタ適用後のマクロ実行

過去の「Excel グラフのプロットからデータを見つける」という質問に回答されていたプロットされたマーカーをひとつだけ選択してマクロを実行は出来たのですが、オートフィルター適用後のグラフに対してはうまくいきません。どのように修正したら良いのかご教授ください。 Sub Test1() Dim myPoint As Point Dim myFormula As String Dim myPDLname As String Dim myWsName As String Dim x As String Dim y As String Dim n As Integer If TypeName(Selection) <> "Point" Then Exit Sub If TypeName(Selection) = "Point" Then Set myPoint = Selection myFormula = myPoint.Parent.Formula With myPoint .HasDataLabel = True myPDLname = myPoint.DataLabel.Name .HasDataLabel = False End With n = Split(myPDLname, "P")(1) x = Split(myFormula, ",")(1) y = Split(myFormula, ",")(2) myWsName = Split(x, "!")(0) End If MsgBox myWsName & "!" & Range(x)(n).Address & ":" & Range(y)(n).Address Sheets(myWsName).Select Sheets(myWsName).Range(Range(x)(n), Range(y)(n)).Select End Sub

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1615/2454)
回答No.1

元のコードを生かしてこのような感じでいかがでしょう。 略 Dim mRangeX As Range, mRangeY As Range 中略 y = Split(myFormula, ",")(2) myWsName = Split(x, "!")(0) End If Set mRangeX = SetRange(Range(x), n) Set mRangeY = SetRange(Range(y), n) MsgBox myWsName & "!" & mRangeX.Address & ":" & mRangeY.Address Sheets(myWsName).Select Sheets(myWsName).Range(mRangeX, mRangeY).Select End Sub Function SetRange(ByRef mRange As Range, ByVal n As Integer) As Range Dim mCount As Integer Dim c As Range mCount = 1 For Each c In mRange.SpecialCells(xlCellTypeVisible) If mCount = n Then Set SetRange = c Exit For End If mCount = mCount + 1 Next End Function

taxtarari
質問者

お礼

今まで四苦八苦していたのでとても助かりました。本当にありがとうございました。

関連するQ&A

  • 2010 excel マクロ 記号の変化

    エラー発生で強制終了になってしまいます。2007年のexcelで作成したものですが、2010だと強制終了になってしまいます。 内容は□をダブルクリックすると■になるように作っています。 記述は2003年からのマクロ記述なので、変化が必要なのでしょうか? Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'セルをダブルクリックすると、・→○→△→×→・と変更する。 Dim S1 As String Dim S2 As String Dim S01 As String Dim S02 As String Dim S03 As String Dim S04 As String S1 = "□" S2 = "■" S01 = "・" S02 = "○" S03 = "△" S04 = "×" On Error GoTo ERR_12 sCheckXY S1, S2 sCheckX1234 S01, S02, S03, S04 sChangeXY S1, S2 Exit Sub ERR_12: End End Sub Sub sChangeXY(X As String, Y As String) '選択セルに□があれば■に変える Dim Str0 As String 'str1の左端 Dim Str1 As String 'strの右側更新 Dim Str2 As String 'strの左側更新 Dim Str20 As String 'strの左側一部保存 Dim L As Long Dim M As Long Dim N As Long Str1 = ActiveCell.Text L = Len(Str1) Debug.Print L If L = 0 Then End End If For N = 1 To L Debug.Print Str2 Str0 = Left(Str1, 1) If Str0 = X Or N = L Then If Str20 <> "" Then If N = L Then Str20 = Str20 + Str0 End If If MsgBox(Str20 & "  はチェックしますか?", vbYesNo, "選択肢") = vbYes Then Str2 = Str2 + Replace(Str20, X, Y) Str20 = Str0 Else Str2 = Str2 + Replace(Str20, Y, X) Str20 = Str0 End If Else Str20 = Str0 End If Else Str20 = Str20 + Str0 End If Str1 = Right(Str1, L - N) Next N ActiveCell.Value = Str2 End Sub Sub sCheckXY(X As String, Y As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X Then ActiveCell.Value = Y End ElseIf ActiveCell.Text = Y Then ActiveCell.Value = X End End If End Sub Sub sCheckX1234(X1 As String, X2 As String, X3 As String, X4 As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X1 Then ActiveCell.Value = X2 End ElseIf ActiveCell.Text = X2 Then ActiveCell.Value = X3 End ElseIf ActiveCell.Text = X3 Then ActiveCell.Value = X4 End ElseIf ActiveCell.Text = X4 Then ActiveCell.Value = X1 End End If End Sub

  • vba

    下記はマクロコードの最初のほうをもってきたものですが、 TypeName(Selection) = "Range" And Selection.Value<> "" の意味を説明していただけませんか。 TypeNameとは何か (Selection)とは何か TypeName(Selection) とは何か TypeName(Selection) = "Range" とは何か Selectiionとはカーソルがさしている何か1つのセルのようなものとみていいのでしょうか。 よくTypeName(Selection) = "Range" と検索するとフィットするのですが、何のために使っているのがわかりません。どういう目的のためにTypeName() 関数というのは、使われますか。 Sub Macro1() Dim ptr As Long Dim str As String If TypeName(Selection) = "Range" And Selection.Value <> "" Then   ptr = 0

  • オートフィルタのマクロについて

    オートフィルタのマクロを組もうとしているのですが、フィルタ条件に別シートのセルの値を入れたいのですが、そこがどうもうまくいきません。 作成したマクロは以下の通りです。 Sub 累計計算マクロ() Dim aRange As Range, bRange As Range, i As Date Set aRange = Sheets("累計").Range("B1") Set bRange = Sheets("累計").Range("B2") i = aRange.Value Sheets("クイーンエステート").Activate Range("A13:L13").Select Selection.AutoFilter Selection.AutoFilter Field:=2, Criteria1:="<=i", Operator:=xlAnd End Sub どなたか助けてください! 宜しくお願い致します。

  • エクセルのマクロ

    Sub test() Dim x As Range  For Each x In Selection    If x.Value <> "●" And Selection.Font.ColorIndex = 0 Then    x.Value = "○"  End If Next End Sub 上記は、選択されているセルのフォントが黒でかつ"●"が入力されていない場合は"○"を入力する、というマクロですがうまく動作しません。どうすれば正常に動作するようになるでしょうか?

  • マクロでの次の実行マクロへの記述

    下記のマクロを記述しました。 一つのマクロ処理を終わらせて、次のマクロ(例:test)を動かしたいのですが何処に 記述したら良いかわかりません。 教えてください。 Sub Macro1() Dim i As Integer Dim buff As String i = 2 While 1 If Range("B" & i).Value = "" Then End End If buff = Range("B" & i).Value Range("B" & i).Value = Left(buff, 7) + " " + Mid(buff, 8, 5) + " " + Right(buff, 6) i = i + 1 Wend   Call test →ここに仮に記述したのですが、testのマクロに行きません。 End Sub 以上

  • エクセルVBAで指定したセルへジャンプするコード(追加の追加質問です)

    http://oshiete1.goo.ne.jp/qa2903797.html たびたびすみません。最後にひとつだけお願いします。 お教えいただいた下のコードは順調に動作するのですが、 対象セルが結合セルの場合、エラーが出てしまいます。 とまってしまうコードの部分は With Selection.AddComment です。 エラーメッセージにはプロシージャの呼び出し、 または引数が不正です。(Error 5)と書いてあります。 結合セルは動作しないものでしょうか? Sub test01() Dim x As String Dim ThisSheet_Name As String Dim Sheet_Name As String Dim Range_Name As String Dim I As Integer, n As Integer Dim Ans As Integer Dim myComment As String '新規追加 Dim Colors As Integer '新規追加 ThisSheet_Name = ActiveSheet.Name '設定シート Select Case Workbooks.Count Case 1 MsgBox "チェックするファイルがありません。" Exit Sub Case 2 For n = 1 To 2 If Workbooks(n).Name <> ThisWorkbook.Name Then x = Workbooks(n).Name '開いている“もうひとつのブック”の名前 End If Next Case Else MsgBox "他に開いているファイルが複数のため対象を特定できません。" Exit Sub End Select I = 0 Do While (1) With ThisWorkbook.Sheets(ThisSheet_Name) If .Range("A3").Offset(I, 0).Value = "" Then MsgBox "検査項目は以上です。" ThisWorkbook.Activate Exit Do 'A列の3行目以下が、空白なら終わる End If Sheet_Name = .Range("A3").Offset(I, 0).Value Range_Name = .Range("B3").Offset(I, 0).Value myComment = .Range("C3").Offset(I, 0).Value End With Windows(x).Activate Sheets(Sheet_Name).Select Range(Range_Name).Select Colors = Selection.Interior.ColorIndex '新規追加 Selection.Interior.ColorIndex = 6 With Selection.AddComment .Visible = True .Text myComment End With Range(Range_Name).Select Ans = MsgBox("「次をチェックしますか?」", vbYesNo) Selection.Interior.ColorIndex = Colors '修正 Selection.ClearComments '新規追加 If Ans = vbYes Then I = I + 1 Else Exit Do End If Loop End Sub

  • VBA 変数の指定について

    エクセル2010を使っている者です。 過去の質問を見ていると、以下の記述が見つかりました。 Sub swap() Dim w, x As Range, y As Range If Selection.Areas.Count <> 2 Then Exit Sub Set x = Selection.Areas(1) Set y = Selection.Areas(2) w = x.Formula x.Formula = y.Formula y.Formula = w End Sub 変数の指定のところで、x, yはRangeの型を指定していますが、 wはどのようになっているのでしょうか? 検索してみると、変数の型を書かないと自動でVariantとして扱われるように なっているとのことですが、この場合もwもVariant型になっているのでしょうか? また、このようにwを中途半端に書かずに Dim x As Range, y As Range とwを外して書いてしまってもwは変数として機能するのでしょうか? よろしくお願いいたします。

  • マクロ実行後に操作を元に戻したい

    自作の時間割変更プログラムを使っています。 次のマクロを何度か実行した後に一つずつ元に戻したいのですが。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Rng As Range Dim m, n, s On Error Resume Next If Selection.Count <> 2 Then Exit Sub m = ActiveCell.Value n = ActiveCell.Interior.ColorIndex For Each Rng In Selection If Rng.Address <> ActiveCell.Address Then ActiveCell.Value = Rng.Value ActiveCell.Interior.ColorIndex = Rng.Interior.ColorIndex Rng.Value = m Rng.Interior.ColorIndex = n End If Next Rng End Sub 時間割のコマを移動した後に間違いが見つかり、間違いの時点まで元に戻して訂正したいのですが、Ctrl+zがきかず困っています。 Excel 365、windows 10を使用しています。どうにかなりませんか?

  • セルの値をテキストボックスへ記入及び名前変更

    範囲選択したセルに丸オートシェイプを挿入すると共に、それぞれのセルの値をテキストで追加及び、図形名を同じ値にしたいと思っています(下記の***の部分)。この時セルは結合されている場合があります。 描写は下記のようにしたのですが、セルの読み込みで詰まってしまいました。セルの値を読み込むにはどの様なしたらいいのでしょうか? 宜しくお願い致します。 Sub 選択されたセルに丸テキスト挿入() Dim X As Double Dim Y As Double Dim L As Double Dim c As Range If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection With c.MergeArea If c.Address = .Item(1).Address Then L = IIf(.Width > .Height, .Height, .Width) X = .Left + (.Width - L) / 2 Y = .Top + (.Height - L) / 2 ActiveSheet.Shapes.AddShape(msoShapeOval, X, Y, L, L).Select Selection.Name = *** Selection.Characters.Text = "***" Selection.ShapeRange.Fill.Visible = msoFalse      Selection.HorizontalAlignment = xlCenter With Selection.Characters(Start:=1, Length:=3).Font .Size = 8 End With End If End With Next End Sub

  • マクロの変数のことで

    Sub test() Dim x As Range, y As Range Dim i As Integer i = 0 Set y = Application.InputBox("", "Paste", Type:=8)  For Each x In Selection   x.Cut y.Offset(i, 0)   i = i + 1  Next x End Sub 上記マクロは、選択されているセルを切り取って、指定したセルを基点として下方向に貼り付けるものです。 "i"の初期値を"1"にすると成功しますが、"0"だとエラーになります。"-3"などにすると、値がゼロになった時点でエラーになります。なぜ"i"がゼロになるとエラーになってしまうのでしょうか?  指定したセルを基点にして貼り付けられるようにするには、どうすればいいでしょうか?

専門家に質問してみよう