[[20230324010134]] 『VBAで検索』(ばったもん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBAで検索』(ばったもん)

すみません、そもそも出来るものなのか全くイメージがわきませんが

セルに品番を入力してマクロのボタン押す、
もしくはユーザーフォームのテキストボックスに品番を入力して押す

あらかじめパスを指定した社内サーバーからその品番のデータ名に該当xlsxを検索して、抽出くれて
て選択出来る様になったり
そんな事は可能でしょうか?

部分一致であったり完全一致であったり自分でもイメージがわかないです。

サーバーのフォルダがたくさん分岐している中から品番に該当するExcelデータを何とか速く探し出して開きたいです。

< 使用 Excel:Microsoft365、使用 OS:Windows11 >


この辺りで聞いてみれば・・・。

https://axcis.co.jp/vba/?utm_source=yahoo&utm_medium=cpc&yclid=YSS.1001131688.EAIaIQobChMIu-iGnrHw-wIVUq6WCh3e_A-CEAAYASAAEgLGTfD_BwE

https://www.techsoudan.com/tech-support.html?r=ppc%7Cyahoolpa%7C6%7C&mkwid=&jpkw=%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E3%83%9E%E3%82%AF%E3%83%AD%E3%82%B3%E3%83%BC%E3%83%89&pmt=b&pdv=c&pkw=%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E3%83%9E%E3%82%AF%E3%83%AD%E3%82%B3%E3%83%BC%E3%83%89&JPDC=b&JPNW=s&pcrid=632725625241&pdv=c&JPRC=1&JPAF=txt&campaignid=18801034455&yclid=YSS.1001207837.EAIaIQobChMIu-iGnrHw-wIVUq6WCh3e_A-CEAAYAyAAEgLNUPD_BwE

(ココス) 2023/03/24(金) 02:17:11


おはようございます。。。^^
品番がファイル名[部分一致も可だったかな^^;]なら
何もせずともOSのエクスプローラでサーバーの特定フ
ォルダ[あらかじめパスを指定]を選択して検索欄に品番
コピペで、自動検索、有れば表示してくれますよ。あと
はファイルの場所を開く。でフォルダが自動移動。。。
と言う手もあるのでは。。。ないでせうか。^^;
でわ
m(__)m

(隠居Z) 2023/03/24(金) 08:51:37


>あらかじめパスを指定した社内サーバーからその品番のデータ名に該当xlsxを検索して、抽出くれて
て選択出来る
イメージが今一つわかりませんが、順番に【ファイル名】をみて、【条件にあうもの】を【リストボックスに追加】みたいなことなら可能だとおもいます。

(もこな2) 2023/03/24(金) 08:54:20


 >すみません、そもそも出来るものなのか全くイメージがわきませんが

手動なら、時間かけても探し出せますよね?
その手順を自動化するだけですよ。
自動化したらかなり速く探せるかと思います。
ただその方法で実用的に遅いとなったら、
元のデータを空いている時間に探しやすい形に集めておくと、
さらに速く探し出せるかと思います。

参考URL>>
http://home.att.ne.jp/zeta/gen/excel/c03p04.htm
http://home.att.ne.jp/zeta/gen/excel/c01p10.htm

自作に時間がかかるならば、
市販のデータベースソフトを利用するとか検討した方がよいかと。

(まっつわん) 2023/03/24(金) 10:31:05


ファイルを検索したいなら

https://happy-tenshoku.com/post-1304/

こんな感じでどうですか?
(アルゴリズム) 2023/03/24(金) 11:57:16


folderのみ書き換えましたが、以前から使用しているもので、汚いです。

B2セルに入力した文字列を含むexcelファイルをA2セルのディレクトリ内からexploreの機能で検索します。
対象はファイル名およびセル内文字です。
検索文字列にひらがなやカタカナを使用するとセル内文字に読み仮名が含まれる場合はそれも該当します。
(例:"東京都"と手入力で入れたセルがある場合phononicとして"とうきょう"および"トウキョウ"が含まれるため、
   検索文字を"とうきょう"としても"東京"を含むセルも検索してしまいます。
B2セルの文字が変わるとuserformが表示され、対象が検索されます。
(A2セルが空白だと検索ディレクトリを聞いてきます)
少し時間がかかるため内部の表示がアイコン表示からリスト表示になるまで待って下さい。
検索されたファイルをダブルクリックするとファイルが開き、
検索と置換画面によりブック検索を行います。(Sendkeysにて行っていますので、タイミングにより動作しない場場合があります。
その場合は手作業でブック検索して下さい)

UserForm2にWebBrowzer1を配置します。
UserForm2モジュール・標準モジュール・ブックモジュール・シートモジュールに以下を記載します。

'UserForm2モジュール

 Private Sub UserForm_Initialize()
    Dim bstrFilterText As String     'FileFilter 演算子は大文字のこと
    usf2 = True
    bstrFilterText = 文字 & " AND 名前:*.xls AND NOT 名前:" & ThisWorkbook.Name
    With Me.WebBrowser1
        .Top = 0
        .Left = 0
        .Width = Me.Width
        .Height = Me.Height
        .Navigate strFol
        .Document.FOLDERFLAGS = &H40000001  '検索サブフォルダを含む)
        .Document.FilterView bstrFilterText
    End With
 End Sub

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    usf2 = False
 End Sub

 Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
    Dim s As Long
    s = Me.WebBrowser1.Document.CurrentViewMode
    If s <> 4 Then
        Me.WebBrowser1.Document.CurrentViewMode = 4 'リスト形式
    End If
 End Sub

'標準モジュール

 Public usf2 As Boolean
 Public 文字 As String
 Public strFol  As String

 Sub 初回記入()
    With ActiveSheet
        Application.EnableEvents = False
        .Range("A1:B1").Value = Array("検索場所", "検索文字列")
        .Range("B2").Interior.Color = vbYellow
        Application.EnableEvents = True
    End With
 End Sub

'ブックモジュール

 Private Sub Workbook_Deactivate()
    If usf2 Then
        Unload UserForm2        'そのまま別のファイルを続けるならコメントアウト
                                '但し最後にフォームは手作業で閉じること
        'ブックの全て検索
        Cells(1).Find 文字, , xlValues, xlPart, , , , False     '検索条件を設定
        Application.CommandBars.FindControl(ID:=1849).Execute   '検索と置換を開く
        With CreateObject("WScript.Shell")
            .SendKeys "%T{TAB 2}{DOWN 2}"    'オプション表示の状態が不明なので2回試行で検索場所をブックとする
            .SendKeys "%T{TAB 2}{DOWN 2}"
            .SendKeys "%I"                   '全て検索
        End With
    End If
 End Sub

'シートモジュール

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Target(1).Address(0, 0) = "B2" Then
        文字 = Target(1).Value
        If 文字 = "" Then Exit Sub
        strFol = Range("A2").Value
        If strFol = "" Then
            With Application.FileDialog(msoFileDialogFolderPicker)
                If .Show = False Then Exit Sub
                strFol = .SelectedItems(1)
                Application.EnableEvents = False
                Range("A2").Value = strFol
                Application.EnableEvents = True
            End With
        End If
        UserForm2.Show 0
    End If
 End Sub

(kazuo) 2023/03/24(金) 14:31:07


あ、サーバー環境無いので確認していません。動作しなかったらごめんなさいです。
捨てて下さい。
(kazuo) 2023/03/24(金) 14:36:00

みなさん、多くのアドバイスありがとうございます
返答が遅くなってもうしわけありません、
少しずつ、になりますが皆さんのアドバイスを全てトライしてみようと思います

プロシージャなど参考にさせていただきますs
(ばったもん) 2023/03/25(土) 17:03:09


こんにちは、返信できずに申し訳ありません。先日退院してパソコンを触れるようになりました。
リンクを貼ってくださった方、案をくれた方本当にありがとうございます。

kazuo様のモジュールをそのまま使わせて頂きましたところ、一番これが自分のやりたいイメージに近く
社内サーバにも運用出来て、素晴らしい動きをしてくれたので大切に使わせて頂きます。

注文をつけるようで申し訳ないのですがこのkazuo様のモジュールに

★サブフォルダーもデフォルトで検索するようにしたい
(kazuo様のモジュールではサブフォルダーをクリックしてから検索に入る)

★リスト表示時での順番やバーの長さ、表示するリストを変更したい
(kazuo様のモジュールでは 名前 更新日時 種類 サイズ フォルダー場所 となっているが
(名前 フォルダー場所 更新日時 などに指定して フォルダー場所のバーの長さを伸ばし
表示が隠れないように)

などは元々無理な仕様でしょうか。宜しくおねがいいたします。 

(ばったもん) 2023/03/29(水) 18:19:19


詳しくないですがデフォルトの詳細表示を任意で変更は
VBAで難しいのでは?
でもユーザーフォームだから可能なのかもしれませんが
(おに) 2023/03/30(木) 08:18:12

 >★サブフォルダーもデフォルトで検索するようにしたい
 >>       .Document.FOLDERFLAGS = &H40000001  '検索サブフォルダを含む)
 ありゃ、検索できるはずですがサーバはダメなのかもしれません。

 >★リスト表示時での順番やバーの長さ、表示するリストを変更したい
 以前、確認したときは、表示するリスト・順番はサブフォルダ表示しない場合は、
 レジストリの変更で可能だと結論しましたが、ドキュメントが無い中で作成したものなので
 私には解りませんし、これ以上解析するつもりありません。
 https://excelfactory.net/excelboard/excelvba/cfs.cgi?word=184350&logs=33.txt

(kazuo) 2023/03/31(金) 16:48:01


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.