[[20160204162931]] 『ファイル名に特定の文字列を含むファイルがあるか』(ピューマ) ページの最後に飛ぶ

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

 

『ファイル名に特定の文字列を含むファイルがあるか調べたい』(ピューマ)

テキストボックスなどを置いて、参照するフォルダ名(パス)を入力して
特定の文字列を含むファイルが存在するか調べたいです。

特定の文字列というのは、「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


回答いただきありがとうございます!稲葉さんのコードを参考にしつつ、自分でも調べて進めてみます。大変助かりましたm(__)m
(ピューマ) 2016/02/05(金) 12:35

コメント返信:

[ 一覧(最新更新順) ]


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