戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 親トピックをトピックトップへ ]
このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 

このトピック参照回数 :
Re[4]: オートフィルター使用して検索

    [196333] Re[4]: オートフィルター使用して検索-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ みい -(2024/11/22(15:06))
    □U R L/

      kazuo様

      再度コードを書いていただきありがとうございます。
      一旦 列を作って「全角・ひらがな」に統一にして検索するんですね
      確かにこれだと半角ののカナとR字も検索できます。

      >Rows("10:65536").Select
      上記についてはだいぶん昔に教えていただいたコードが
      動いてるので使い回しで未だに使用していました。

      あまりEXCELのVBAが作る事ないので今回考え方も含め勉強に
      なりました。
      ありがとうございました。




    [196327] Re[3]: オートフィルター使用して検索-

    記事引用/メール受信=OFF■

    □投稿者/ kazuo -(2024/11/20(09:05))
    □U R L/
      >Rows("10:65536").Select
      ということは、Excel2003以前ですか?
      今後質問するときはOS選択、Excelのバージョン選択を必ずしてください。
      
      環境ないので試せませんが、
      >    cr(2).Formula2 = "=IFERROR(SEARCH(WideHiragana(" & _
      >            検索条件セル & "),WideHiragana(リスト!E2)),FALSE)"
      Range.Formula2プロパティの動作に不安がありますし、ワークシート関数IFERRORも使えそうもありませんので、
      
      >なにぶん建物名の検索なので元の文字を直すの事はありません。
      作業列方式を採用ください。
      一例
      なお、複数の検索値を使用する場合は、リストが変更になるまでは作業列を一々消さずに検索するよう考慮してみてください。
      
      Sub Macro作業列方式()
          Dim myName As String
          Dim myData
          Dim myRange As Range
          Dim 作業列 As Range
          Dim i As Long
          
          '以前の検索をクリア
          With Worksheets("検索シート")
              .Activate
              .Rows("10:" & .Rows.Count).Delete
              myName = .Range("c3").Value
          End With
         
          If myName <> "" Then
              With Worksheets("リスト").Range("A1")
                  If .Worksheet.FilterMode Then .AutoFilter   'フィルター解除
                  Set myRange = .CurrentRegion
                  myData = myRange.Resize(myRange.Rows.Count + 1).Columns(5)  '2行以上を担保
                  Set 作業列 = myRange.Offset(, myRange.Columns.Count).Resize(, 1)
              End With
              For i = 2 To UBound(myData)
                  myData(i, 1) = StrConv(myData(i, 1), vbWide + vbHiragana)   '全角・ひらがなに変換
              Next
              With 作業列
                  .Value = myData
                  .AutoFilter 1, "*" & StrConv(myName, vbWide + vbHiragana) & "*" '全角・ひらがなでフィルター
                  myRange.Copy Worksheets("検索シート").Range("A9")
                  .AutoFilter
                  .ClearContents
              End With
          '検索シートの10〜200列まで高さを【20】にした
              Worksheets("検索シート").Range("10:200").RowHeight = 20
          End If
      End Sub
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [196324] Re[2]: オートフィルター使用して検索-

    記事引用/メール受信=OFF■

    □投稿者/ みい -(2024/11/19(16:58))
    □U R L/
      kazuo様
      お忙しいなかコードを書いていただきありがとうございます。
      
      
          cr(2).Formula2 = "=IFERROR(SEARCH(WideHiragana(" & _
                  検索条件セル & "),WideHiragana(リスト!E2)),FALSE)"
       上記で「アプリケーション定義またはオブジェクト定義のエラーです。」
      とでました。
      Functionでちょっと調べてもおぼつかなく、またそれだけの技量もなく
      わかりませんでした。申し訳ありません。
      
      
      
      
      もう少し自分で調べて
      Sub これで検索w()
      
      '以前の検索を削除
          Sheets("検索シート").Activate
          Rows("10:65536").Select
          Range(Selection, Selection.End(xlDown)).Select
          Selection.Delete
       
          Dim myName As String
         
          myName = Range("c3").Value
          If myName = "" Then
          Else
          
          With Sheets("リスト").Range("A1")
          .AutoFilter 5, Array("*" & StrConv(myName, vbNarrow) & "*", "*" & StrConv(myName, vbWide) & "*", "*" & StrConv(myName, vbHiragana) & "*"), xlFilterValues
                         
          .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索シート").Range("A9")
          .AutoFilter
          '検索シートの10〜200列まで高さを【20】にした
          Worksheets("検索シート").Range("10:200").RowHeight = 20
          End With
          End If
          End Sub
      
      こちらだと カタカナは半角で入力すればひらがなとかたかなが混じった「ふれあいセンター」で検索すれば出ますが
      できたら「ふれあいセンター」で検索出来るといいのですが。また「フレアイセンター」でも検索できるとなおいいのですが
      【vbHiragana】を足して4個の検索しましたがこちらは上手くいきませんでした。
      なにぶん建物名の検索なので元の文字を直すの事はありません。
      よろしくお願いします。
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [196322] Re[1]: オートフィルター使用して検索-

    記事引用/メール受信=OFF■

    □投稿者/ kazuo -(2024/11/16(15:34))
    □U R L/
      E列の文字列を全角・ひらがなに変換した作業列を作り、それを検索対象とするか
      
      または全角・ひらがなに変換するユーザー定義関数を作成し、数式を使用したフィルター詳細を利用することが考えられます
      検索する文字列がWorksheets("Sheet2")のC3セルにある場合の例です。
      
      Sub Macro1()
          Const 検索条件シート = "Sheet2"
          Const 検索条件セル = "C$3"
          Dim cr As Range
          
          Set cr = Worksheets(検索条件シート).UsedRange
          Set cr = cr.Offset(, cr.Columns.Count).Resize(2, 1)
      '    cr(1).Value = "検索条件"
          cr(2).Formula2 = "=IFERROR(SEARCH(WideHiragana(" & _
                  検索条件セル & "),WideHiragana(リスト!E2)),FALSE)"
          Worksheets("リスト").Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, cr
          cr.ClearContents
      End Sub
      
      Function WideHiragana(s As String) As String
          WideHiragana = StrConv(s, vbHiragana + vbWide)
      End Function
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



      ++++++++++++++++++++
      OS      ⇒Windows 11
      Version⇒Excel 2021
      ++++++++++++++++++++




    [196321] オートフィルター使用して検索-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ みい -(2024/11/15(10:52))
    □U R L/
      お世話になります。
      図面のタイトルの検索にてオートフィルターを使用してます。
      
      一応R字とカナの半角・全角の検索はできました。
      
       Dim myName As String
           myName = Range("c3").Value
          If myName = "" Then
          Else
          With Sheets("リスト").Range("A1")
          .AutoFilter Field:=5, Criteria1:="*" & StrConv(myName, vbNarrow) & "*", Operator:=xlOr, Criteria2:="*" & StrConv(myName, vbWide) & "*"
      
      上記だとひががな・カナの検索ができないので
      
      Dim myName1, myName2
          myName1 = Range("c3").Value
          myName2 = Range("c3").Value
          If myName1 = "" Then
          Else
          If myName2 = "" Then
          Else
          
          With Sheets("リスト").Range("A1")
          .AutoFilter Field:=5, Criteria1:="*" & StrConv(StrConv(myName1, vbWide), vbHiragana) & "*", Operator:=xlOr, Criteria2:="*" & StrConv(StrConv(myName2, vbWide), vbHiragana) & "*"
      上記だと 反対にR字・カナに対応しません。
      全部に対応するコードはありますでしょうか?


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



このトピック内容の全ページ数 / [0]

- Child Forum -
Edit:ゆう-G