質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
86.12%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

解決済

フィルタされた内容を配列に入れてから配列の中身でOR条件にてソートしたい

kumiko
kumiko

総合スコア45

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

1回答

0グッド

0クリップ

403閲覧

投稿2022/10/26 05:02

編集2022/10/26 06:17

前提

E列とAJ列の項目は重複しているものが多数あります。
2つのコードを載せますが1つ目のコードは動作は問題ないです。
関係あるかわからないので載せてます。

実現したいこと

こんな感じの表があります

イメージ説明

  • AJ列を一つのキーでソート
  • ソートされた状態でE列に出てきている内容(以下の例だとE000113,E000114,E000115,E000116)を配列に入れる

イメージ説明

  • いったんフィルタを解除

  • 配列の内容で(OR条件で)E列をソートしなおす

発生している問題

  • ソートされた状態でE列に出てきている内容(以下の例だとE000113,E000114,E000115,E000116)を配列に入れる

↑配列には入っている様子…かとおもいきやE000113,E000114,E000115,E000116のあと空で5回msgboxがでます

  • 配列の内容で(OR条件で)E列をソートしなおす

↑エラーはおきないですがフィルタがかかっていない状態です

エクセルVBA

Sub 共通親抽出() 'マクロ実行画面の凍結 Application.ScreenUpdating = False '変数宣言 Dim zuban As Variant Dim endRow As Long ' 最下行の取得 endRow = Cells(Rows.Count, 36).End(xlUp).Row '抽出キーの入力指示 zuban = InputBox("変更する図番を版数抜で入力して下さい。") 'キャンセルした場合の処理 If zuban = Empty Then Exit Sub End If 'オートフィルタがかかっていなかったらかける 'かかっていたら念の為一度解除し再設定 If ActiveSheet.AutoFilterMode = False Then Range("A1:AS" & endRow).Select Selection.AutoFilter Else Selection.AutoFilter Range("A1:AS" & endRow).Select Selection.AutoFilter End If Range("E1").Select '「図番」の列(36列目)で、抽出キーを含むものを抽出 Selection.AutoFilter Field:=36, Criteria1:="=*" & zuban & "*", Operator:=xlAnd 'Range("E1").CurrentRegion.Offset(1, 0).Resize(Range("E1").CurrentRegion.Rows.Count - 1).Interior.Color = 65535 End Sub
Sub 図番でのソート後配列に格納して再度フィルタ() Dim d(100) '配列の数 Dim Buff As Variant Range("E1").CurrentRegion.Select Set Buff = Range("A2:AS48").SpecialCells(xlCellTypeVisible) For Each Cl In Buff If Cl.Column = 5 Then d(k) = Cl k = k + 1 MsgBox Cl ’ここで確認すると配列には入っている様子…かとおもいきやE000113,E000114,E000115,E000116のあと空で5回msgboxがでます End If Next Range("A2:AS48").AutoFilter 'フィルタ解除 Dim MaxRow As Long MaxRow = Cells(Rows.Count, 36).End(xlUp).Row Range(Cells(1, 5), Cells(MaxRow, 45)) _  .AutoFilter Field:=5, _ Criteria1:=Cl, _ Operator:=xlFilterValues End Sub

補足情報(FW/ツールのバージョンなど)

エクセル2013です

修正①
改めて動作させたらすこし現象が違いました。
発生している問題書き換えしました
修正②
★②Cells(1,5)→Cells(1,1)に修正 不要な修正でした…。

以下のような質問にはグッドを送りましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

グッドが多くついた質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

気になる質問をクリップする

クリップした質問は、後からいつでもマイページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

下記のような質問は推奨されていません。

  • 間違っている
  • 質問になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

適切な質問に修正を依頼しましょう。

pig_vba

2022/10/26 05:42

Clはfor eachカウンターとして動かしてる以上終了条件満たしてループ抜けた時点で範囲外参照してませんかねこれ。ClにNULL入ってません?
kumiko

2022/10/26 05:49

そうです! 発生している問題を編集しましたが空で5回msgboxがでてきます。 エラー停止はせず記載部分44行を丸々フィルタした状態になりました。
bebebe_

2022/10/26 05:57

フィルターの抽出文字列はdになるのでは?
kumiko

2022/10/26 07:07

bebebeさん そのようですね。コメントありがとうございました。

回答1

2

ベストアンサー

(1027編集)大ガバをやらかしました。BuffをRange型に定義変更してるからUbound使えるわけなかったです。デバッグなしで直書きはやはり横着過ぎてダメですね。反省

Excel

1 2Sub 図番でのソート後配列に格納して再度フィルタ() 3 Dim d As Variant 4 Dim Buff As Range 5 'range型確定なので先に宣言 6 Dim Cl As Range 7 Dim maxRow As Long 8 9 Dim ws As Worksheet: Set ws = ActiveSheet 10 11 maxRow = ws.Cells(ws.Rows.Count, 36).End(xlUp).Offset(1, 0).Row - 1 '(最下行が非表示になってる可能性を考慮) 12 Set Buff = ws.Range("E1:E" & maxRow).SpecialCells(xlCellTypeVisible) 13 14 Dim k As Long 15 k = 0 16 ReDim d(Buff.Cells.Count) 'BuffはRange型なのでセル数を取得 17 18 For Each Cl In Buff 19 'ClはRangeオブジェクトだからvalueだけ記憶 20 d(k) = Cl.Value 21 k = k + 1 22 Next 23 24 25 26 maxRow = ws.Cells(Rows.Count, 36).End(xlUp).Row 27 28 ws.Range("A2:AS" & maxRow).AutoFilter 'フィルタ解除 29 30 31 ws.Range(ws.Cells(1, 5), ws.Cells(maxRow, 45)) _ 32 .AutoFilter Field:=1, _ 33 Criteria1:=d, _ 34 Operator:=xlFilterValues 35 36 37End Sub 38 39

尚、d(0)にはタイトルの”部品コード”が格納されてしまいますが、余計なキーと空キーはデータ範囲に存在しない分には問題ないので意図的に無視してます(k=0のときだけ処理飛ばせばいいだけですが、それを書くとfor eachを使ってる意義がなくなりますので可読性が下がります)

これで要望通りの使用になってる…はず。勉強不足で追記だらけで申し訳ない

投稿2022/10/26 06:07

編集2022/10/27 02:56
pig_vba

総合スコア648

spoofy_dragon, kumiko👏を押しています

良いと思った回答にはグッドを送りましょう。
グッドが多くついた回答ほどページの上位に表示されるので、他の人が素晴らしい回答を見つけやすくなります。

下記のような回答は推奨されていません。

  • 間違っている回答
  • 質問の回答になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

このような回答には修正を依頼しましょう。

回答へのコメント

pig_vba

2022/10/26 06:11

空のMSGBOXが出てくるのはBuffにセットするセル範囲を48行目まで固定にしてるからです。 きっかりデータ格納行の最下行を取得してセットしておけばそういう不具合は出ません。
kumiko

2022/10/26 07:07

ありがとうございます。動作確認しました。期待どうりに動きました。 途中途中の突っ込み、ありがたいです。かみしめます。
kumiko

2022/10/26 07:15

ごめんなさい、ちょっと不具合が…。確認時間ください
kumiko

2022/10/26 07:29

一番最初の番号、画像でいうところのAJ2の「E000113-00」でAJ列をソートした状態で動作させた時だけ「実行時エラー9 インデックスが有効範囲にありません」となって デバックで「d(k) = Cl.Value」が黄色くなります。 ソート結果が一行でも他のフィルタでは問題は起きないのですが…。
pig_vba

2022/10/26 07:34

エラーが出る状態で該当行の直前に Msgbox Cl.value を追加して何が表示されるか確認してもらえますか?
pig_vba

2022/10/26 07:40

今気づきましたがkの初期化式が入ってなかったので修正しました。
kumiko

2022/10/26 08:22

修正されたコードで動作させてみたのですがやっぱりE000113-00のときのみ不具合が… If k > 99 Then Exit For  のあとに MsgBox Cl.Value をいれたところA1,B1,C1…と項目行を横に格納していました。※E000113-00のとき 具体的には空、空、空、空、部品コード、…といったかんじです すみません、本日はこれ以降返信できなそうです
pig_vba

2022/10/27 00:56

行データが格納…?済みませんが私の知識では根本原因の特定が難しそうです。 暫定版でどういった挙動をするか確認していただけますでしょうか。
kumiko

2022/10/27 01:45

暫定版では ReDim d(UBound(Buff)) の”UBond”に色がついて「コンパイルエラー:配列がありません」とでました。 私もいろいろ実験してみました。 まずは一行目を空行にすれば期待どうりの動作(E000113-00でソートした行の検索でもうまくいく)はしました。 でもやっぱりそれではちょっとモヤモヤするので1つ前に書いていただいたコードいじっていたところ Set Buff = Range("E2:E" & maxRow).SpecialCells(xlCellTypeVisible) のところをRange("E1:E" & maxRow)にしたところ配列には”部品コード”,"E000113"と入って期待の動作をしてくれました。 配列に検索ワードを入れるには…というところからコードを考えはじめたので項目名を外さねばとE2から選択していたのですが結果的には項目名が入っても動作は同じでした。 一応うまくいったコード書きます。 ★マークのところ私の追記です ↓ Sub 図番でのソート後配列に格納して再度フィルタ() Dim d(100) '配列の数←固定長にしてるのめっちゃ怖い Dim Buff As Variant 'range型確定なので先に宣言 Dim Cl As Range Dim maxRow As Long Range("E1").CurrentRegion.Select '↓E列だけでよくない?あと48行目まで固定だと今後使い辛そう。最下行取って可変にしたほうがいいです maxRow = Cells(Rows.Count, 36).End(xlUp).Offset(1, 0).Row - 1 '(最下行が非表示になってる可能性を考慮) Set Buff = Range("E1:E" & maxRow).SpecialCells(xlCellTypeVisible) '★★★Range("E2:E" & maxRow)から修正 'よくみたらk初期化してへんやんけ!!!!!!--------------------------------------------------- Dim k As Long k = 0 '------------------------------------------------------------------------------------------- For Each Cl In Buff 'E列しか取得してないからIf分も不要 'ClはRangeオブジェクトだからvalueだけ記憶 d(k) = Cl.Value k = k + 1 'やっぱ怖いから条件追加しとこ If k > 99 Then Exit For MsgBox Cl.Value '★★★配列には“部品コード”,”E000113”とはいっていた。 Next Range("A2:AS" & maxRow).AutoFilter 'フィルタ解除 '上記の設定方法なら再設定しなくてもいいけど一応 maxRow = Cells(Rows.Count, 36).End(xlUp).Row 'キーはClじゃなくてd()ですよ Range(Cells(1, 5), Cells(maxRow, 45)) _ .AutoFilter Field:=1, _ Criteria1:=d, _ Operator:=xlFilterValues 'Criteria1:=array(...)と同じ End Sub この初期化対応を記載いただく前のコードではE1から選択にかえても 実行時エラー91 オブジェクト変数またはwithブロック変数が設定されていません とでてしまったので、とっても重要だったのですね… で、あの、解決はしたものの、暫定版では配列の固定長問題を解決しようとしてくださっていますよね 私も知りたいのでこの問題も解決した状態になるのであればコード修正おねがいできますでしょうか。 自分でも解決版とドッキングさせて検討はつづけておりますが今の時点ではうまくいっておりません。 (いまはReDim d(UBound(Buff))で型が一致しないと怒られ中です) よろしければ…。
kumiko

2022/10/27 03:29

ありがとうございます! 確認しました。ばっちりでした。固定長の問題も解決いただきありがとうございます。 プラスアルファ勉強になりましたし、よりいいものになって本当によかったです。 これからじっくり確認していきたいと思いますがまずはお礼申し上げます。
pig_vba

2022/10/27 04:45

補足ですが、今回は可読性優先で無視しましたが本来はReDim d(Buff.cells.Count-1)です。Rangeが1から始まることに対して配列は0から始まるからです。(Option Base [a]が定義されていた場合は[a]から始まりますが)間違って理解してしまわないように一応付け加えておきます。

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
86.12%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

同じタグがついた質問を見る

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。