• 締切済み

AdvancedFilter 検索 複数条件

cj_moverの回答

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.4

(3/3)前の投稿の続きです。 ◆3) 差し当たり、VBA初級のマッチングとしてLike演算子を使ってみます。 (簡単な例としてLike演算子を使いますが、  InStr(),InStrRev()関数を組合わせて使えば、少し難しいけど、精度はやや上。) メモリ上で、カンマ区切りに切り分け、個々の文字列について、   *「品目」*「サイズ」* に該当するものが見つかれば、作業列にフラグを吐いておいて、 作業列にてフィルターを掛けて抽出します。 1)と比べると、「品目」の後(カンマの前)に「サイズ」があれば、 その間が[半角スペース*1]でなくてもどんな文字列でもマッチします。 ただ、1)3)共通の難点ですが、 例えば、「品目」"スカート"で抽出する場合"ミニスカート"もマッチしますし、 例えば、「サイズ」"15"で抽出する場合"150","1500","115"もマッチします。 この点は、1セル1データ、でない以上、分別するのに 詳細なサンプルと比較的高度な技術とが必要になります。 全角・半角を区別しないように、モジュールの先頭でOption Compare Textを宣言します。 代償としてアルファベットの大文字・小文字の区別もできなくなります。 また、データに特定の文字?*#{}!を含む場合は、正しい結果が得られないか、エラーになります。 こういうのは、文字列をフィルターに掛ける時には必ず付いてまわる条件ですから、 実データの在り方や運用の在り方等勘案して、必要に合わせた書き方をする、 ということになります。 その意味では、他人任せでは、ナカナカ思い通りのものに辿り着けないのかも知れません。 これより精度を高める必要があれば、VBSの正規表現を勉強するとか、 案外、Excelの数式(関数)を応用することで対応できる場合もあるかも知れません。 「検索(パターンマッチング)」と「抽出」の2段階に分けて処理する、 ということで、簡単なサンプルです。 (作業セルを仮にBS列にして書いてあります。変更は BS を置換。) /// Option Compare Text ' ← 必ず、モジュールの先頭に記述。 Private Sub CommandButton2_Click()   Dim v   Dim c As Range   Dim sCriteria_1 As String ' 抽出条件「品目」   Dim sCriteria_2 As String ' 抽出条件「品目   Dim sCriteria_W As String ' 抽出条件文字列   Dim nBottomRow As Long ' T列を基準に最下行を取得   ' ' 抽出条件「品目」を取得   sCriteria_1 = TextBox1.Value   ' ' 抽出条件「品目」が空なら、メッセージを表示して、処理終了   If sCriteria_1 = "" Then     MsgBox "品目を入力して!"     Exit Sub   End If   ' ' 抽出条件「サイズ」を取得   sCriteria_2 = TextBox2.Value   ' ' 対象シートについて、選択、フィルター抽出状態ならばキャンセル   With Worksheets("マスタ")     .Select     If .FilterMode Then .ShowAllData   End With   ' ' 抽出条件文字列を作成   If sCriteria_2 = "" Then     sCriteria_W = "*" & sCriteria_1 & "*"   Else     sCriteria_W = "*" & sCriteria_1 & "*" & sCriteria_2 & "*" '    sCriteria_W = "*" & sCriteria_1 & "*" & sCriteria_2 & "サイズ*"   End If   ' ' T列を基準に最下行を取得   nBottomRow = Cells(Rows.Count, "T").End(xlUp).Row   ' ' 作業列の値を(必要なら)消去   With Range("BS4:BS" & nBottomRow)     If Application.Count(.Cells) Then .ClearContents   End With   ' ' T列のデータ範囲をループ   For Each c In Range("T4:T" & nBottomRow)     ' ' 個々のデータをカンマ区切りで切り分けた文字列をマッチング     For Each v In Split(c.Value, ",")       ' ' マッチすれば、作業列の同じ行のセル値を 1 に       If v Like sCriteria_W Then         Cells(c.Row, "BS").Value = 1         Exit For       End If     Next   Next   ' ' 作業列を基準にオートフィルター(ボタン非表示)   Range("BS2:BS" & nBottomRow).AutoFilter _     Field:=1, _     Criteria1:=1, _     VisibleDropDown:=False   ' ' 作業列の値を消去   Range("BS4:BS" & nBottomRow).ClearContents   ' ' 以下、元コードのまま   Range("A1").Activate   Application.Calculation = xlCalculationAutomatic   Application.ScreenUpdating = True End Sub /// ◆4) 端的にいえば、現在のデータの在り方が、Excelが得意とするデータの在り方ではない、ということです。 この特殊な事情が理由で、簡単に結論を導くことが難しくなっているようですし、、 この回答がこれほどの長文になってしまう所以でもあります。 因みに、ワークシートメニューの[データ][区切り文字]でカンマ区切りを指定すれば、 データを列方向に展開することが可能ですが、この機能は1セル1データを確保する為に用意されたものです。 しかしまあ、1)で挙げた条件のように、データの入力フォーマットが、 ルール上でも運用上でも堅いものであるならば、現状のままでもある程度の対応は可能かと思います。 ただ、今後もExcelで新しい分析機能を追加していくということであれば、 やはり全体の設計を見直した方が苦労が少ないようにも思います。 でも、実物を、経験のある人が見て、という条件でないと、設計を変えるにも方向が定まらないと思います。 環境が許すなら外注するのが早いでしょうけれど、それが難しいようでしたら、 ひとつひとつ確かめながら工夫していくことになるのでしょう。 その際、求める仕様、をハッキリさせ、使うツールの仕様、を確認して(理解を深め)、 繰り返し相互にフィードバックしながらより確かなアプローチを見つけて行く、ことが大事です。 今回の例でいえば、実際に手を動かしてフィルターオプションを知る、ということからでしょうか。 1)のサンプルでも良さそうだったら検証を踏まえて確実なものにするとか、 3)のサンプルを元にLike演算子に出来ることできないことを確認しておくとか、 正規表現を覚えるとか、、、。 #"複数条件"の意味が3つ以上の抽出条件、という話だったりする?場合も #上記の応用で可能な場合が殆どだと思いますが、うまく行かない場合は、 #適当な例示を添えて再度質問を建て直した方が解決は近いと思います。 (3/3) 以上、ご参考まで。長、失礼しました。

ivuivu0603
質問者

補足

色々教えて頂いてありがとうございます。 データは一つのセルに、30種類くらい入っているものもあり、 実際のデータは、車種一覧です。 車種例えば(プリウス)半角スペース型番(20系) 車種は、全角で型番は半角です。 その間のスペースは、半角にしてます。 オートフィルターで検索をした場合、きちんと 結果がでるのは、(プリウス¢20) です。 あいまい検索ですると、20が含む行が全てでてしまうので、 プリウス、 かつ20を含むが良いのですが、 この場合書いて頂いた中で、何番があてはまりますか?

関連するQ&A

  • VBAで複数検索、AdvancedFilter

    AdvancedFilterを使って、検索を行っているのですが、応答なしと固まってしまったり、動作が重くなったりするのですが、原因わかりますでしょうか? 3000行くらいなのですが、ユーザーフォームを立ち上げて、検索、結果を見て、また検索をしようとすると固まったりして動かなくなって強制終了になる場合があります。 軽くなる方法はありますか? Private Sub CommandButton1_Click() Worksheets("商品マスタ").Activate If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ActiveWindow.ScrollRow = 3 Range("S1:AA4").ClearContents Range("S1:AA4").NumberFormatLocal = "@" Range("T2:U2").Value = Range("B2:C2").Value Range("V2:X2").Value = Range("D2").Value Range("Y2:Z2").Value = Range("E2:F2").Value Range("AA2").Value = Range("G2").Value If Me.TextBox1.Value <> "" Then ' コード Range("U3").Value = "*" & Me.TextBox1.Value End If If Me.TextBox2.Value <> "" Then ' メーカー Range("V3").Value = "*" & Me.TextBox2.Value & "*" End If If Me.TextBox3.Value <> "" Then ' シリーズ Range("W3").Value = "*" & Me.TextBox3.Value & "*" End If If Me.TextBox4.Value <> "" Then ' サイズ Range("W3").Value = "*" & Me.TextBox4.Value & "*" End If If Me.TextBox5.Value <> "" Then ' 入荷日 Range("T3").Value = Me.TextBox5.Value End If If Me.TextBox9.Value <> "" Then ' 仕入れ先 Range("Z3").Value = Me.TextBox9.Value End If If Me.TextBox12.Value <> "" Then ' 単体価格 Range("AA3").Value = Me.TextBox12.Value End If If Me.TextBox6.Value <> "" Then ' 在庫数 Range("Y3").Value = Me.TextBox6.Value End If If Cells(3, Columns.Count).End(xlToLeft).Column > 19 Then Range("A2:G" & Rows.Count).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=Range("S2").CurrentRegion, Unique:=False End If Range("S1:AA4").ClearContents ActiveWindow.ScrollColumn = 4 Range("A2").Activate End Sub Private Sub CommandButton2_Click() Unload Me End Sub

  • Excel VBA テキストボックスを検索

    テキストボックス3に数値を入力し ExcelのA列にあるか検索をかける。 ある場合は、B列の同じ行に 「みーつけた!」と入力。 その設定で組んでみたのですが、 テキストボックス3にデータを6桁入力しようとすると 6桁目にオーバーフローエラーが出ます。 このプログラムの何処がおかしいのでしょうか? Private Sub TextBox3_Change() Dim Number As Integer If TextBox3.Value <> "" Then '空じゃない場合 Number = TextBox3.Value Call 検索(Number) MsgBox TextBox3.Value End If End Sub Sub 検索(ByVal Number As Variant) Dim FoundCell As Range Set FoundCell = Range("A:A").Cells.Find(What:=Number, lookat:=xlPart) If FoundCell Is Nothing Then Else FoundCell.Activate Range("O" & ActiveCell.Row).Value = "みーつけた!" End If End Sub

  • このVBA、もうちょっとシンプルにできないですか?

    自力でVBAを書いてみたのですが、長くなってしまいました。 もうちょっとシンプルにするアイディアがあればお願いします。 やりたいことは、 (1)ユーザーフォームのテキストボックス内が空欄だったら「無視」 (2)テキストボックスの中が空欄でなければ「書き込み」 以上のことをやりたいのですが、テキストボックスが6種類あるので単純に記述すると結構長くなってしまいました。 特に問題がなければ、その旨をお願いします。 If TextBox1 = "" Then If TextBox2 = "" Then If TextBox3 = "" Then If TextBox4 = "" Then If TextBox5 = "" Then If TextBox6 = "" Then MsgBox ("得点が入力されていません。") ElseIf TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If ElseIf TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value ElseIf TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If ElseIf TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value If TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If End If ElseIf TextBox3 <> "" Then Sheets("総合(得点)").Cells(t + 6, u) = TextBox3.Value If TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value If TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If End If End If ElseIf TextBox2 <> "" Then Sheets("総合(得点)").Cells(t + 5, u) = TextBox2.Value If TextBox3 <> "" Then Sheets("総合(得点)").Cells(t + 6, u) = TextBox3.Value If TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value ・ ・ ・ こんな感じで規則的に記述しただけです。(文字数が多いので最後は省略しました) 段差がなくて見づらいですが、宜しくお願いします。

  • 条件判定について

    下記のようなコードを作成しましたが、チェックボックスがオンでもオフでもTextBox4.Valueの値が返ります。どこがいけないでしょうか。 Private Sub CommandButton2_Click() If CheckBox1.Visible = True Then Worksheets("sheet1").Range("a1") = TextBox4.Value Else Worksheets("sheet1").Range("a1") = TextBox3.Value End If End Sub

  • エクセルマクロ_テキストボックスをシートに反映(その2)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム) 先ほどは大変お世話になりました。 複数行に応用させようとしたのですが、管理番号が余計に記載(テキストボックス(出荷日など)が空欄であっても、管理番号だけはとられてしまいます)されてしまいます。すみませんが、ご教授よろしくお願いいたします。 リストボックス1のデータは、Sheet1を表示しています。→管理番号はSheet2のA最終行に記載されます。 テキストボックス1(回答日)は、上記の管理番号記載のとなりに、 テキストボックス2(出荷日)は、テキストボックス1記載のとなりに、 ・・・とテキストボックス4(コメント)(これはK列)に1行で記載されます。 ↑ここまでは、教えていただいたので、完璧なのですが、 テキストボックス2~4までの内容を、あと複数行(4件)追加できるように試してみたのですが、空欄であっても管理番号だけは常に記載されてしまいます。 テキストボックス2と5に記載されている場合は、Sheet2に値を反映させるが、空欄の場合は、値を反映させないようにしたいのです。 (Sheet1=データベース) C5   D5 管理番号 品名 アカ12 りんご アオ56 みかん クロ34 なし クロ89 すいか アオ12 もも (Sheet2=入力シート) A(管理番号)    B(回答日)    C(出荷日)   D(数量)     K(コメント) アオ56        8月9日        8月10日      75     送り先の確認 アオ56                    8月11日      80 クロ34        9月4日        9月5日      80 (今回は、2行で作成した場合のマクロを記載しました) Private Sub UserForm_Initialize() With ListBox1 .ColumnWidths = "0;0;50;50" .ColumnCount = 4 .RowSource = "Sheet1!A5:D" & Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row End With End Sub Private Sub CommandButton1_Click() If TextBox2.Value Then Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox1.Value) Then .Range("B" & lRow + 1).Value = TextBox1.Value End If If IsDate(TextBox2.Value) Then .Range("C" & lRow + 1).Value = TextBox2.Value End If If IsNumeric(TextBox3.Value) Then .Range("D" & lRow + 1).Value = TextBox3.Value End If .Range("K" & lRow + 1).Value = TextBox4.Value End With End If If TextBox5.Value Then Dim llRow As Long With Worksheets("Sheet2") llRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & llRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox5.Value) Then .Range("C" & llRow + 1).Value = TextBox5.Value End If If IsNumeric(TextBox6.Value) Then .Range("D" & llRow + 1).Value = TextBox6.Value End If .Range("K" & llRow + 1).Value = TextBox7.Value End With End If Dim myCtrl As Control For Each myCtrl In Controls If TypeName(myCtrl) = "TextBox" Then myCtrl.Value = vbNullString End If Next End Sub (ユーザーフォーム) リストボックス1=Sheet1のデータを反映 テキストボックス1(回答日) テキストボックス2(出荷日),テキストボックス3(数量),テキストボックス4(コメント)←1件目 テキストボックス5(出荷日),テキストボックス6(数量),テキストボックス7(コメント)←2件目 ↑1件目のみでコマンドボタンを押した場合は、1件目のみの管理番号取得をしたいのです。が今は、2件目が空欄でも管理番号はとられてしまいます。 長くなってしまいすみません。 どなたかご回答いただければ幸いです。よろしくお願いいたします。

  • エクセル2010、VBAや関数について

    Private Sub CommandButton1_Click() Worksheets("商品マスタ").Activate Application.Calculation = xlCalculationManual If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ActiveWindow.ScrollRow = 3 Range("AI1:AQ4").ClearContents Range("AI1:AQ4").NumberFormatLocal = "@" Range("AJ2:AK2").Value = Range("B2:C2").Value Range("AL2:AM2").Value = Range("D2").Value Range("AO2").Value = Range("E2").Value Range("AP2").Value = Range("V2").Value Range("AQ2").Value = Range("W2").Value Range("AN2").Value = Range("D2").Value If Me.TextBox1.Value <> "" Then ' コード Range("AK3").Value = "*" & Me.TextBox1.Value End If If Me.TextBox2.Value <> "" Then ' メーカー Range("AL3").Value = "*" & Me.TextBox2.Value & "*" End If If Me.TextBox3.Value <> "" Then ' <--シリーズ Range("AM3").Value = "*" & Me.TextBox3.Value & "*" End If If Me.TextBox4.Value <> "" Then ' <--サイズ Range("AN3").Value = "*" & Me.TextBox4.Value & "*" End If If Me.TextBox5.Value <> "" Then ' 入荷日 Range("AJ3").Value = Me.TextBox5.Value End If If Me.TextBox9.Value <> "" Then ' 仕入れ先 Range("AP3").Value = Me.TextBox9.Value End If If Me.TextBox12.Value <> "" Then ' 単体価格 Range("AQ3").Value = Me.TextBox12.Value End If If Me.TextBox6.Value <> "" Then ' 在庫数 Range("AO3").Value = Me.TextBox6.Value End If If Cells(3, Columns.Count).End(xlToLeft).Column > 34 Then Range("A2:W" & Rows.Count).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=Range("AI2").CurrentRegion, Unique:=False End If Range("AI1:AQ4").ClearContents ActiveWindow.ScrollColumn = 4 Range("A2").Activate Application.Calculation = xlCalculationAutomatic End Sub このようなマクロを組んでいるのですが、とても反応が遅いのですが、 シートにはA4-AG2000にデータが入っていて、 G4-U2000には =SUMIFS('[在庫.xlsx]02'!$AD:$AD,'[在庫.xlsx]02'!$AQ:$AQ,$A421,'[在庫.xlsx]02'!$AS:$AS,$F$2,'[在庫.xlsx]02'!$AT:$AT,G$2) このような関数が入っております。 これが原因で、動作が遅くなっているのでしょうか? 行の挿入等もとても遅いのですが、 G-U列の関数をやめてVBAで転記してから、検索をかけたら、早くなるのでしょうか? G-U列には関数での表記しかわからなかったため、関数をいれております。 解決法があれば教えてください。

  • ユーザーフォームでの任意の文字を含む検索について

    初心者の質問で申し訳ございません。 ユーザーフォームを利用して検索ボタンを作りました。 ユーザーフォームでテキストボックスを2個と コマンドボタン1個を作成し、 テキストボックス1に検索したい氏名を入力して コマンドボタンを押すと、 ワークシートに作成されたデータのD列から 一致するものを検索し、 一致したデータのA列にある「番号」をテキストボックス2、 表示する。 このサイトで教えていただき、以下のようなプログラムで 検索することができました。 しかし、テキストボックス1の文字が完全に一致すれば結果は出るのですが、 文字を含むものを検索するように改良したいのですがどのようにすればいいのか 分からず困っています。 よろしくお願いいたします。 ************************** Private Sub CommandButton1_Click() Dim res  If TextBox1.Text <> "" Then   res = Application.Match(TextBox1.Text, Sheets("データ").Columns(4), 0)   If IsNumeric(res) Then    TextBox2.Text = Sheets("データ").Cells(res, "A").Value   Else    TextBox2.Text = "Not Found"   End If  Else   TextBox2.Text = ""  End If End Sub

  • ExcelVBAで行と列の検索

       A  B  C  D  E 1  コード あ  い  う  え 2  10  ○    ○ 3  20     ○  ○ 4  30          ○ 上記の表が5000件あります。Textbox1に入力し検索ボタンを押すと A列のコードを検索して一致する列の○のあるところの1行目の項目 をtextbox2に表示したいのですがうまく行きません。 よろしくお願い致します。 Private Sub CommandButton1_Click() '検索フォームボタン Dim i As Long Dim 最終行 As String Dim サーチ行 As Long Sheets(1).Activate 最終行 = Range("A1").End(xlDown).Row サーチ行 = 0 For i = 2 To 最終行 If TextBox1.Value = Range("A" & i) Then If Range("B" & i, "N" & i) = "" Then TextBox2.Text = Range("B1", "N1") サーチ行 = i Exit For End If End If Next If サーチ行 = 0 Then MsgBox TextBox1.Value & "データはありません。", vbInformation, "無し" End If TextBox1.SetFocus End Sub エラーはでません。データはありませんとなります。  

  • VBAの計算について教えてください。

    お世話になります。 VBA超初心者です。 教えて頂けると助かります。 ユーザーフォームにテキストボックス1、2、3を作成し、それらを計算させて テキストボックス4に表示をさせたいと考えています。 テキストボックスに入力するパターンは以下の2種類です。 (1)すべてのテキストボックスに数値が入る (2)テキストボックス3のみに数値が入る 行いたい計算は、“(テキストボックス1 × テキストボックス2) + テキストボックス3”です。 曲りなりに作成してみましたが、テキストボックス3の数値を変えた時や削除した時などに、 テキストボックス4に入っている数値が残っていたりと、思うようにできません。 作成したものを掲載しておきます。 何卒よろしくお願いします。 テキストボックス1を変更したとき 1、3に数値が入っていれば、以下の計算を。 それ以外は“0”をテキストボックス4へ Private Sub TextBox1_Change() If TextBox1.Value = True And TextBox3.Value = True Then TextBox4 = Val(TextBox1.Text) * Val(TextBox2.Text) + Val(TextBox3.Text) Else TextBox4 = 0 End If End Sub テキストボックス2を変更したとき 2、3に数値が入っていれば、以下の計算を。 それ以外は“0”をテキストボックス4へ Private Sub TextBox2_Change() If TextBox2.Value = True And TextBox3.Value = True Then TextBox4 = Val(TextBox1.Text) * Val(TextBox2.Text) + Val(TextBox3.Text) Else TextBox4 = 0 End If End Sub テキストボックス3を変更したとき 1、2、3に数値が入っていれば、以下の計算を。 1か2に数値がなく、3に数値があれば、3の数値をテキストボックス4へ。 それ以外は“0”をテキストボックス4へ Private Sub TextBox3_Change() If TextBox1.Value = True And TextBox2.Value = True And TextBox3.Value = True Then TextBox4 = Val(TextBox1.Text) * Val(TextBox2.Text) + Val(TextBox3.Text) ElseIf TextBox1.Value = False or TextBox2.Value = False And TextBox3.Value = True Then TextBox4 = Val(TextBox3.Text) Else texbox24 = 0 End If End SubEnd Sub

  • VBAのFor構文で

    質問させていただきます。 IF textBox1.value = "" then End If のように、VBAのテキストボックスが空白の場合に起動する構文を作ろうと考えているのですが、 このテキストボックスの数が多いので、どうにかして短く出来ないかと考えています。 VBAのテキストボックスを直接For構文で変更する事は可能なのでしょうか? 例えば For i = 1 to 20 IF textBox(i).value = "" then End If Next i 上記のような構文では実際に動かしたときにtextBoxの指定がされていないのでエラーが出てしまいます。 やはり、各テキストボックスごとに構文を作らなければならないのでしょうか? もし可能なら、その方法を教えていただきたいです。