[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイル名に特定の文字列を含むファイルがあるか調べたい』(ピューマ)
テキストボックスなどを置いて、参照するフォルダ名(パス)を入力して
特定の文字列を含むファイルが存在するか調べたいです。
特定の文字列というのは、「1212」「2232」「4949」「5921」「1979」「決定」「終了」です。
この順番に一つずつ調べて、見つかったファイルだけ、順番に、ひとまずリストボックスなどに表示させたいです。
表示させたい名称はファイル名ではなく「1212」や「2232」です。
最終的にはリストボックスに表示させたものを、B4〜順番に下に表示させたいです。そのときに、リストボックスに表示されていても必要でない場合があるので、例えばリストボックスの横にチェックボックスのようなものを設置して、不要の場合だけチェックを外して、チェックのついたものだけ表示させる、という風にしたいです。
リストボックスにチェックボックスを置くやり方は、自分では出来ませんでしたが。。
Do While strFileName <> ""
' 行を加算 GYO = GYO + 1 Cells(GYO, 1).Value = strFileName ' 次のファイル名を取得
If Dir() Like "*1212*" Then
End If Loop
これはセルに直接ファイル名を出しているんですが、ファイルの1行目から順に「1212」を含むものがあるか、「2232」を含むものがあるか、と調べてしまうので、もし先頭に来なければならない「1212」を含むファイルが3行目とかにあった場合に、順番がぐちゃぐちゃになってしまいます。。
説明が下手ですみません。。
どうぞ宜しくお願いします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
いくつかヒントだけ
http://officetanaka.net/excel/vba/tips/tips144.htm
リストボックスには、MultiSelectプロパティがあるので、これでチェックしたものだけ出力するというのは どうでしょうか?
>「1212」を含むファイルが3行目とかにあった場合に、順番がぐちゃぐちゃになってしまいます。。 並べ替えはセルに出力後にエクセルのい機能で並べ替えてはどうですか?
(稲葉) 2016/02/04(木) 17:10
エクセルの機能で並べ替えとはどういうことでしょう?フィルタを使用するということでしょうか。
特定の文字列が昇順でも降順でもないので、フィルタでは難しいかもしれません。。
(ピューマ) 2016/02/04(木) 17:35
ユーザーが指定した順序で並べ替える方法があります。 [[20151229135315]] 『ユーザー設定リストで並べ替え後、上書き保存出来』(稲葉)
(β) 2015/12/29(火) 16:20 さんの投稿を参考にしてください。
(稲葉) 2016/02/04(木) 17:44
そろそろパソコン落とすので叩き台だけ置いておきます。 出来れば自分で作ってみてください。
新しいブックを作ってください。 ユーザーフォームを一つ配置してください(UserForm1) リストボックスとコマンドボタンを一つ配置してください(ListBox1、CommandButton1) 標準モジュールを一つ挿入してください(Module1)
標準モジュールに以下のコード(★〜★)を入れてください。
★ Option Explicit '=====実行するコード Sub ファイルチェックスタート() '======================================== Dim oFolPic Dim lst As Variant Dim FP As String Dim FNs As Variant Dim CKs As Variant lst = Array("1212", "2232", "4949", "5921", "1979", "決定", "終了")
Set oFolPic = Application.FileDialog(msoFileDialogFolderPicker) If oFolPic.Show = True Then FP = oFolPic.SelectedItems(1) FNs = GetFNs(FP) CKs = chkLst(FNs, lst) If IsArray(CKs) Then With UserForm1 .myList = CKs .mkList .Show End With End If End If End Sub
'=====ファイル名を抽出するユーザー関数 Private Function GetFNs(p As String) As Variant '======================================== Dim f Dim ans As String With CreateObject("Scripting.FileSystemObject") For Each f In .getfolder(p).Files ans = ans & Chr(2) & f.Name Next f End With GetFNs = Split(Mid(ans, 2), Chr(2)) End Function
'=====リストと突き合わせをするユーザー関数 Private Function chkLst(FNs As Variant, lst As Variant) As Variant '======================================== Dim f As Variant Dim c As Variant Dim ans As Variant Dim cnt As Long ReDim ans(1 To 2, 1 To 1) cnt = 1 For Each c In lst For Each f In FNs If f Like "*" & c & "*" Then ReDim Preserve ans(1 To 2, 1 To cnt) ans(1, cnt) = c ans(2, cnt) = f cnt = cnt + 1 Exit For End If Next f Next c If cnt > 1 Then chkLst = Application.Transpose(ans) End Function ★
ユーザーフォームに以下のコードを入れてください
Option Explicit
Public myList As Variant '======================================== Public Sub mkList() '======================================== Dim i As Long With ListBox1 .ColumnCount = 2 .MultiSelect = fmMultiSelectMulti .List = myList For i = 0 To .ListCount - 1 .Selected(i) = True Next i End With End Sub
'======================================== Private Sub CommandButton1_Click() '======================================== Dim i As Long Dim ans As String Dim cnt As Long cnt = 0 With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then cnt = cnt + 1 ans = ans & Chr(2) & .List(i, 0) End If Next i End With If cnt > 0 Then Sheets.Add after:=Sheets(Sheets.Count) Sheets(Sheets.Count).Range("A1").Resize(cnt).Value = Application.Transpose(Split(Mid(ans, 2), Chr(2))) MsgBox "新しいシートに出力しました" Else MsgBox "出力するデータがありません" End If End Sub
標準モジュールの「ファイルチェックスタート」を実行してください
フォルダ選択ダイヤログが出て、フォルダを選択します リストに合致したファイル名がリストボックスに表示され、選択状態になっています。 リストからいくつか選択を外し、コマンドボタンを押すと、新しいシートに選択された リスト値が出力されます。
(稲葉) 2016/02/04(木) 18:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.