色彩を教える人になるための講座「色彩講師養成講座」の魅力とは>>

ExcelのK3セルのフィルターで一つチェックを入れて表示してから、実行するボタン(マクロ)が有ります。

今は、フィルターをしていなくても、実行できますが、
K3セルのフィルターで一つを選んでからでないと、

エラーにして、
[フィルターで一つにチェックを入れて!]と、注意文を画面に表示させたいです。

どうか、マクロを教えて下さい。

質問者からの補足コメント

  • うーん・・・

    試してみましたが、これだとフィルターされていない時、実行され、
    何個かフィルターしている時エラーになります(逆です)。
    フィルターされていない時と複数選択時にエラーで、
    一個だけフィルターしている時、実行する方法を教えて下さい。

    No.3の回答に寄せられた補足コメントです。 補足日時:2021/10/13 11:20
  • つらい・・・

    すみません、普通にそれだけで実行すると、OKでした。
    他のマクロ(フィルター一つのみ選択時、のみ貼付)に挿入して使うので、
    その組み込み方法が分かりません。
    教えて頂けますか。

      補足日時:2021/10/13 12:07
  • うーん・・・

    ほぼ、出来たのですが、一つ解決出来ません。
    K列のフィルターは1つずつ処理が終わると非表示にして行きます。
    K列のフィルターが二個以上有る場合は良いのですが、

    K列のフィルターラスト1個の場合は、フィルターを1つ選択して下さい、とメッセージボックスが出て、貼付が出来ません。

    このラスト1個の時は、そもそもフィルターを選択出来ないので、ふぃるたーを1つ選択した時と同じような動作をしたいです。

    お願いします。教えて下さい。

    No.4の回答に寄せられた補足コメントです。 補足日時:2021/10/13 15:37
  • つらい・・・

    長文なので数回に分けて質問(1)。
    MsgBox ("仕入先名フィルター設定は:" & .AutoFilter.Filters(i).Criteria1 & " です")
    と、
    MsgBox ("最後のキーです")
    の下にそれぞれ同じ動作の下記マクロを挿入したいのですが、一つ挿入は問題ないですが、二個挿入すると、
    宣言が重複してるとエラーになります。
    同じ宣言しないで違う宣言にするか、二個目は、一個目に飛ぶような方法が知りたいです。

    Dim N As Long, myRng As Range
    Set myRng = Range(Range("A3"), Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible)
    N = myRng.Cells(1, 1).Row

      補足日時:2021/10/14 12:04
  • つらい・・・

    長文なので数回に分けて質問(2)。

    Range(Cells(N, 21), Cells(N, 21)).Copy
    Dim rw As Long
    rw = Application.Max(Cells(Rows.Count, 11).End(xlUp).Row, 11) - 3
    Range("U4").Resize(rw).SpecialCells(xlCellTypeVisible).Select
    Dim u As Range, c
    For Each c In Selection
    If Not c.EntireRow.Hidden Then
    If u Is Nothing Then Set u = c Else Set u = Union(u, c)
    End If

      補足日時:2021/10/14 12:07
  • つらい・・・

    長文なので数回に分けて質問(3)最終。

    Next
    If Not u Is Nothing Then u.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    (1)(2)(3)のコピー、貼付のマクロを
    MsgBox ("仕入先名フィルター設定は:" & .AutoFilter.Filters(i).Criteria1 & " です")
    と、
    MsgBox ("最後のキーです")
    の下に挿入して同じ動きをさせたいです。

    よろしくお願いします。

      補足日時:2021/10/14 12:12
  • うーん・・・

    元のSub ボタン1_Click()
    の中に

    Sub メイン処理(i As Long)
    Dim N As Long, myRng As Range

    MsgBox ("仕入先名フィルター設定は:" & ActiveSheet.AutoFilter.Filters(i).Criteria1 & " です")
    End Sub

    End Sub

    教えて頂いたマクロを元のSub ボタン1_Click()~End Subの中にどう入れたらいいですか?
    Subが二つになるとEnd Subが足りないと・・・。
    すみません、教えて下さい。

    No.6の回答に寄せられた補足コメントです。 補足日時:2021/10/14 14:45
  • HAPPY

    ①フィルター何も選んでいないと"フィルターをひとつ選んで"→OK!
    ②フィルター複数チェック入れると"フィルターは1つだけ選んで"→OK!
    ③フィルター1つだけ選ぶと"仕入先フィルターはです"→OK!
    ですが、
    ④最終フィルターの時、"最後のキーです"→が、表示されず、コピー&貼付が出来ません。(テスト用の簡略化したシートでは、"最後のキーです"が出てコピー貼付が上手く出来ました。)本番のシートでは、出来ません。極たまに、成功した時が・・・なぜ?
    ほとんど出来ませんでした。
    本番のシートでは、列がたくさん有るので、一列、ダミーの列にして、
    最終フィルターにはならない方向(最終だけど、ダミーがあるので選択出来る)で妥協です。
    本当は、全てマクロを見てもらって流れを見て貰いたいのですが・・・。
    最後に質問です。
    こういうエクセルの表とマクロとを見て貰って、手直ししてくれる所ってありますか?

      補足日時:2021/10/16 10:02
  • うれしい

    ちなみに、
    No.6回答でほぼ完成しました。
    No.8回答は、すみません。よくわからず、使いませんでした。
    有り難うございました。

      補足日時:2021/10/16 10:08
gooドクター

A 回答 (9件)

>最後に質問です。


こういうエクセルの表とマクロとを見て貰って、手直ししてくれる所ってありますか?
すみません。知りません。
    • good
    • 0
この回答へのお礼

解決しました

ほんとに助かりました。
一応、満足出来る物が出来ました。
有り難うございました。

お礼日時:2021/10/16 21:56

#6です


現状コード追加補足コードの全貌が良く分かりませんので、
参考になるか分かりませんが私が回答したもので組むと
Sub ボタン1_Click()
Dim i As Long
Dim r As Range, rr As Range
With ActiveSheet
If .AutoFilterMode Then
For i = 1 To .AutoFilter.Filters.Count
If .AutoFilter.Filters(i).On And .AutoFilter.Range(i).Column = 11 Then
If .AutoFilter.Filters(i).Operator <> 0 Then
MsgBox ("フィルターキーは1つだけ選んでください")
Else
Call メイン処理(i)
End If
Exit Sub
Else
If .AutoFilter.Range(i).Column = 11 Then
Set r = .AutoFilter.Range(i).Offset(1)
Set rr = .Range(r, .Cells(Rows.Count, 11).End(xlUp))
If Application.CountIf(rr, r.Value) = rr.SpecialCells(xlCellTypeVisible).Count Then
MsgBox ("最後のキーです")
Call メイン処理(i)
.AutoFilterMode = False
Exit Sub
End If
End If
End If
Next i
MsgBox ("フィルターキーを1つ選んでください")
Else
MsgBox ("フィルターを設定してキーを1つ選んでください")
End If
End With
End Sub
Sub メイン処理(i As Long)
Dim N As Long ', myRng As Range
'Set myRng = Range(Range("A3"), Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible)
'N = myRng.Cells(1, 1).Row
N = 3
Dim rw As Long
Dim u As Range, c As Range
With ActiveSheet
rw = Application.Max(.Cells(Rows.Count, 11).End(xlUp).Row, 11) - 3
For Each c In .Range("U4").Resize(rw).SpecialCells(xlCellTypeVisible)
If Not c.EntireRow.Hidden Then
If u Is Nothing Then Set u = c Else Set u = Union(u, c)
End If
Next
If Not u Is Nothing Then u.Value = .Cells(N, 21).Value
End With
MsgBox ("仕入先名フィルター設定は:" & ActiveSheet.AutoFilter.Filters(i).Criteria1 & " です")
End Sub

ですが、他の処理もきっとあるのですよね。。
ちなみに補足でのコードは
必ず U3セルの値が書き込まれるような処理になっています

= .Cells(N, 21).Value を U3セル決め打ちにしても同じかも
そうすると
Dim N As Long ', myRng As Range
'Set myRng = Range(Range("A3"), Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible)
'N = myRng.Cells(1, 1).Row
はそっくり要りません。。ね
(ご質問(コード)に沿ったコードで汎用性、合理性などは追求していません)
    • good
    • 0

こんにちは。



流れを全て把握していませんが、宣言を全て、Subより上に持ってきては
ダメなのでしょうか? Sub内では、Dim宣言をしないとか。
的外れな回答でしたら、スルー願いします。

Dim N As Long, myRng As Range
Dim rw As Long
Dim u As Range, c As Range

Sub 〇〇〇

End Sub
    • good
    • 0

こんにちは


Dim N As Long, myRng As Range を
プロシージャ上部に1度宣言すれば良いです。
(書く(各)場所には不要)
又は実行前に一度宣言すれば良いです。。(下部に2度宣言する必要はありません)

Call で呼ぶ方法が良いかと


MsgBox ("最後のキーです")
Call メイン処理(i)

補足に挙げられたコード(引数、変数、ActiveSheetを追加)コンパイル
内容は未確認。

処理プロシージャ
Sub メイン処理(i As Long)
Dim N As Long, myRng As Range
Set myRng = Range(Range("A3"), Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible)
N = myRng.Cells(1, 1).Row
Range(Cells(N, 21), Cells(N, 21)).Copy
Dim rw As Long
rw = Application.Max(Cells(Rows.Count, 11).End(xlUp).Row, 11) - 3
Range("U4").Resize(rw).SpecialCells(xlCellTypeVisible).Select
Dim u As Range, c
For Each c In Selection
If Not c.EntireRow.Hidden Then
If u Is Nothing Then Set u = c Else Set u = Union(u, c)
End If
Next
If Not u Is Nothing Then u.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
MsgBox ("仕入先名フィルター設定は:" & ActiveSheet.AutoFilter.Filters(i).Criteria1 & " です")
End Sub
この回答への補足あり
    • good
    • 0

こんばんは


組み込みは出来たと解釈して
>K列のフィルターラスト1個の場合は?
非表示で1つになるかなぁ?、、行削除と言う事で。

>K列のフィルターラスト1個の場合は、フィルターを1つ選択して下さい、とメッセージボックスが出て、貼付が出来ません。

なるほど、、使い方はともかくとして最後にと言う事ですね
.AutoFilter.Filters(i).Onにならないなら、取得も出来ないので、、
力業かな?

最後なので非表示セルがないと思いますが、(補足文ではある事になっていますが)
一応 SpecialCells(xlCellTypeVisible)として

#3のコード間違いもあるので 書き直すと、、
Sub test()
Dim i As Long
Dim r As Range, rr As Range
With ActiveSheet
If .AutoFilterMode Then
For i = 1 To .AutoFilter.Filters.Count
If .AutoFilter.Filters(i).On And .AutoFilter.Range(i).Column = 11 Then
If .AutoFilter.Filters(i).Operator <> 0 Then
MsgBox ("フィルターキーは1つだけ選んでください")
Else
MsgBox ("キー設定は:" & .AutoFilter.Filters(i).Criteria1 & " です")

End If
Exit Sub
Else
If .AutoFilter.Range(i).Column = 11 Then
Set r = .AutoFilter.Range(i).Offset(1)
Set rr = .Range(r, .Cells(Rows.Count, 11).End(xlUp))
If Application.CountIf(rr, r.Value) = rr.SpecialCells(xlCellTypeVisible).Count Then
MsgBox ("最後のキーです")
.AutoFilterMode = False
Exit Sub
End If
End If
End If
Next i
MsgBox ("フィルターキーを1つ選んでください")
Else
MsgBox ("フィルターを設定してキーを1つ選んでください")
End If
End With
End Sub

メッセージ部分が分岐処理結果です。
その場所に実行コード又は実行プロシージャをCallしてみてください
    • good
    • 0

こんにちは#3です。


>その組み込み方法が分かりません。
他のマクロが分からないのでどうなっているのかわかりません。
>(フィルター一つのみ選択時、のみ貼付)

If .AutoFilter.Filters(i).Operator <> 0 Then
MsgBox ("フィルターキーは1つだけ選んでください")
Else
’この部分が1つのみ選ばれている時に実行されます
’従ってここで貼り付けコードを書けば良い?
End If

K列のみに対して調べて実行するのなら
If .AutoFilter.Filters(i).On Then を
If .AutoFilter.Filters(i).On And .Cells(1, i).Column = 11 Then
ちょっとやっつけ感ありますが、K列が対象になるかと。。

全く違う方向に向かっている様でしたら、貼り付けコード(プロセス)を示してもらえると、、いいかな
この回答への補足あり
    • good
    • 0

こんばんは、


参考コードです。
Sub test()
Dim i As Long
With ActiveSheet
If .AutoFilterMode Then
For i = 1 To .AutoFilter.Filters.Count
If .AutoFilter.Filters(i).On Then
If .AutoFilter.Filters(i).Operator <> 0 Then
MsgBox ("フィルターキーは1つだけ選んでください")
Else
MsgBox ("キー設定は:" & .AutoFilter.Filters(i).Criteria1 & " です")
End If
Exit Sub
End If
Next i
MsgBox ("フィルターキーを1つ選んでください")
Else
MsgBox ("フィルターを設定してキーを1つ選んでください")
End If
End With
End Sub

MsgBox部分を参考にコードを実行すれば良いかも
A列からK列までフィルタが掛かっているのなら、、11でいい?
この回答への補足あり
    • good
    • 0

こんばんは



 ActiveSheet.AutoFilter.FilterMode

でフィルタがかかっている状態かどうかが判断できると思いますので、それで分岐してみてください。
https://docs.microsoft.com/ja-jp/office/vba/api/ …
    • good
    • 0

こんばんは。



フィルターですと、下記の記事が参考になるかと思います。
http://officetanaka.net/excel/vba/tips/tips129.htm

ただ、フィルターでK列の1つだけの条件が選ばれているかを調べる方法が
あるのかが、見た限り分りませんでした。
フィルターで絞り込まれているかどうか?は、調べられる様です。

少しでも参考になれば良いですが。。。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング