
No.8
- 回答日時:
#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
はそっくり要りません。。ね
(ご質問(コード)に沿ったコードで汎用性、合理性などは追求していません)
No.7
- 回答日時:
こんにちは。
流れを全て把握していませんが、宣言を全て、Subより上に持ってきては
ダメなのでしょうか? Sub内では、Dim宣言をしないとか。
的外れな回答でしたら、スルー願いします。
Dim N As Long, myRng As Range
Dim rw As Long
Dim u As Range, c As Range
Sub 〇〇〇
End Sub
No.6
- 回答日時:
こんにちは
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
No.5
- 回答日時:
こんばんは
組み込みは出来たと解釈して
>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してみてください
No.4
- 回答日時:
こんにちは#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列が対象になるかと。。
全く違う方向に向かっている様でしたら、貼り付けコード(プロセス)を示してもらえると、、いいかな
No.3
- 回答日時:
こんばんは、
参考コードです。
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でいい?
No.2
- 回答日時:
こんばんは
ActiveSheet.AutoFilter.FilterMode
でフィルタがかかっている状態かどうかが判断できると思いますので、それで分岐してみてください。
https://docs.microsoft.com/ja-jp/office/vba/api/ …
No.1
- 回答日時:
こんばんは。
フィルターですと、下記の記事が参考になるかと思います。
http://officetanaka.net/excel/vba/tips/tips129.htm
ただ、フィルターでK列の1つだけの条件が選ばれているかを調べる方法が
あるのかが、見た限り分りませんでした。
フィルターで絞り込まれているかどうか?は、調べられる様です。
少しでも参考になれば良いですが。。。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
excelで大量の数字の変換
Excel(エクセル)
-
Excelで「1,2,3,4,5」を「1-5」とまとめることはできますか?
Excel(エクセル)
-
エクセル 条件で表示の仕方を変える
Excel(エクセル)
-
4
【計算量Log n】僕は実際の面接でソートの計算量を聞かれて、log nですかねと言ったら「は?」と
Excel(エクセル)
-
5
excelのデータを、セルをまたいで検索することはできますか?
Excel(エクセル)
-
6
Excelで複数のシートの合計を別シートに反映させたいのですが、合計のシートが他のシートとは表が違う
Excel(エクセル)
-
7
excelvbaで画面表示
Excel(エクセル)
-
8
Excel プルダウンリスト
Excel(エクセル)
-
9
エクセルであるセル番地の内容を知りたい
Excel(エクセル)
-
10
エクセルもマクロを教えてください。
Excel(エクセル)
-
11
Excelのフィルター後の一番上のセルをコピーする(マクロ教えて。) Excelで5行目にフィルター
Excel(エクセル)
-
12
すべてのチェックボックスがoffの場合はメッセージそうでない場合は登録
Excel(エクセル)
-
13
EXCELで条件を指定して別シートの貼り付けるマクロを教えてください
Excel(エクセル)
-
14
(Excel)最小限のデータ入力で別シートに転記しリストを作成したい。
Excel(エクセル)
-
15
Excelで連番を振る方法について
Excel(エクセル)
-
16
エクセルって複雑な処理は避けた方が良くないですか?
Excel(エクセル)
-
17
エクセルの保存方法について教えてください。
Excel(エクセル)
-
18
ExcelでVlookupがうまくいきません、どうしてでしょうか
Excel(エクセル)
-
19
【Excel VBA】名前の定義をVBAで自由にコントロールできますか?
Visual Basic(VBA)
-
20
Excelを使って配送料の計算をしたいです。
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
人気Q&Aランキング
-
4
ポールとは?
-
5
レンズフィルターを角型フィル...
-
6
VBAにてオートフィルターの条件...
-
7
フィルターとフードを付ける順...
-
8
SoftBankのあんしんフィルター...
-
9
一眼レフカメラの保護レンズフ...
-
10
フィルターガラスの交換方法に...
-
11
CANON EOS KissデジタルNに合う...
-
12
Nikon d5600 ダブルズームキッ...
-
13
煙草のフィルターが茶色の銘柄...
-
14
リフレクションフィルターを自...
-
15
【たばこ】タール1mのお勧めを...
-
16
レンズフードの互換性について...
-
17
ビデオデッキでエアチェックし...
-
18
PicsArtでフィルターはどこにあ...
-
19
一眼レフカメラの結露対策
-
20
一眼レフレンズのフィルターっ...
おすすめ情報
公式facebook
公式twitter
試してみましたが、これだとフィルターされていない時、実行され、
何個かフィルターしている時エラーになります(逆です)。
フィルターされていない時と複数選択時にエラーで、
一個だけフィルターしている時、実行する方法を教えて下さい。
すみません、普通にそれだけで実行すると、OKでした。
他のマクロ(フィルター一つのみ選択時、のみ貼付)に挿入して使うので、
その組み込み方法が分かりません。
教えて頂けますか。
ほぼ、出来たのですが、一つ解決出来ません。
K列のフィルターは1つずつ処理が終わると非表示にして行きます。
K列のフィルターが二個以上有る場合は良いのですが、
K列のフィルターラスト1個の場合は、フィルターを1つ選択して下さい、とメッセージボックスが出て、貼付が出来ません。
このラスト1個の時は、そもそもフィルターを選択出来ないので、ふぃるたーを1つ選択した時と同じような動作をしたいです。
お願いします。教えて下さい。
長文なので数回に分けて質問(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
長文なので数回に分けて質問(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
長文なので数回に分けて質問(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 ("最後のキーです")
の下に挿入して同じ動きをさせたいです。
よろしくお願いします。
元の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が足りないと・・・。
すみません、教えて下さい。
①フィルター何も選んでいないと"フィルターをひとつ選んで"→OK!
②フィルター複数チェック入れると"フィルターは1つだけ選んで"→OK!
③フィルター1つだけ選ぶと"仕入先フィルターはです"→OK!
ですが、
④最終フィルターの時、"最後のキーです"→が、表示されず、コピー&貼付が出来ません。(テスト用の簡略化したシートでは、"最後のキーです"が出てコピー貼付が上手く出来ました。)本番のシートでは、出来ません。極たまに、成功した時が・・・なぜ?
ほとんど出来ませんでした。
本番のシートでは、列がたくさん有るので、一列、ダミーの列にして、
最終フィルターにはならない方向(最終だけど、ダミーがあるので選択出来る)で妥協です。
本当は、全てマクロを見てもらって流れを見て貰いたいのですが・・・。
最後に質問です。
こういうエクセルの表とマクロとを見て貰って、手直ししてくれる所ってありますか?
ちなみに、
No.6回答でほぼ完成しました。
No.8回答は、すみません。よくわからず、使いませんでした。
有り難うございました。