[[20200806185341]]　『ファイル名の書いてあるセル隣に○をつけたい』（カトウ）　ページの最後に飛ぶ

『ファイル名の書いてあるセル隣に○をつけたい』（カトウ）

はじめまして。
マクロ初心者ですので、ご了承下さい。
たとえば、複数のPDFファイルのあるフォルダがあります。
その中にファイル名（B1セル～B80）が書かれたエクセルがあります。
マクロで、フォルダ内のPDFファイル名を読み、エクセルに書かれたファイル名に
該当するもののA列セルに○をつけることは可能でしょうか？
わかりずらいかもですみません。
フォルダ内のPDFファイル名と同じ名前セル（B列セル）の先頭セル（A列セル）に○を入れたい。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 Dir関数でﾌｧｲﾙの存在ﾁｪｯｸができます。

http://officetanaka.net/excel/vba/file/file06.htm

 ファイルのフルパスで判定しますので、
  フォルダパス+ファイル名(拡張子含む)で有無をチェックします。

 複数のｾﾙにファイル名が入力されている場合は、セルをループします。
（OK） 2020/08/06(木) 19:25

 セルのループの参考ＨＰです。

http://excel-mania.com/vba/for_next4.html
（OK） 2020/08/06(木) 19:28

 逆に、フォルダ内のファイル一覧を取得し、Findメソッドで
 指定のセル範囲の中にファイル名と一致するセルが存在
 するか否かを判定する、という方法も。
（OK） 2020/08/06(木) 20:49

返信、遅れました。
回答して頂き、ありがとうございました。
いろいろ調べて、VBA（試作）ができました。

Sub macro1()

Worksheets("sheet1").Activate

    Range("A1").Select

Dim ThisPath, FileName As String

Dim r As Long
r = 1

ThisPath = ActiveWorkbook.Path 'このExcelのディレクトリ

'Stop

    FileName = Dir(ThisPath & "\*.pdf", vbNormal)
     Do While FileName <> ""
     Cells(r, 1).Value = FileName
     FileName = Dir()
     r = r + 1
     Loop

     'ここまでがフォルダのファイル名を取得
     'ここからがライセンス名を取り出す

    Dim str0        As String
    Dim str1        As String
    Dim wFindStr    As String
    Dim id As String
    Dim id2 As String

    '
    Range("A1").Select

Sub1:

    ActiveCell.Select

    str0 = ActiveCell.Value

    'str0から「#」以前の文を取得
    wFindStr = "#"
    str1 = Left(str0, InStr(1, str0, wFindStr) - 1)

    ActiveCell.Offset(0, 1).Select

    ActiveCell.Value = str1

    ActiveCell.Offset(1, -1).Select

    If ActiveCell.Value = "" Then

    GoTo Sub2:

    Else

    GoTo Sub1:

    End If

Sub2:

'ここからがマシンIDを取り出す

'Stop

id = Range("A1").Value

  Range("C1").Value = Mid(id, InStr(id, "#") + 1)
id2 = Range("C1").Value
  Range("D1").Value = Left(id2, InStr(1, id2, ".") - 1)

    'ここからがファイル名のリストシートに〇をつける

    Worksheets("sheet1").Activate

    Range("B1").Select

Sub4:

    Dim name As String

    name = ActiveCell.Value

    Sheets(2).Select

    Dim FoundCell As Range
    Set FoundCell = Range("B1").CurrentRegion.Find(What:=name)
    If FoundCell Is Nothing Then
        MsgBox "検索に失敗しました"
    Else
        FoundCell.Select
    End If

    ActiveCell.Offset(0, -1).Value = "〇"

    Worksheets("sheet1").Activate

    ActiveCell.Offset(1, 0).Select

    If ActiveCell.Value = "" Then

    GoTo Sub3:

    Else

    GoTo Sub4:

    End If

Sub3:

MsgBox "完了しました"

End Sub

（ミドリ） 2020/08/16(日) 11:46

とりあえず、こんな感じでしょうか？

 '
Sub CheckFolder()
    Dim i As Long
    Dim FName As String

    FName = Dir(ThisWorkbook.Path & "\*.pdf")
    Do While FName <> ""
        For i = 1 To Range("B1").End(xlDown).Row
            If Cells(i, 2) = FName Then
                Cells(i, 1) = "〇"
            End If
        Next i
        FName = Dir()
    Loop
End Sub
（DS） 2020/08/16(日) 12:49

多分、問題があるわけではないですが、気になる部分があるので整理してみました。

■１
↓のように記述すると、「ThisPath」はVariant型を指定したことになります。

 Dim ThisPath, FileName As String

なので、String型にしたい場合は。↓のようにします。

 Dim ThisPath As String, FileName As String

■２
原則として、VBAの世界では「ブック」、「シート」や「セル」などをきちんと明示すればいちいち選択したりアクティブにしたりする必要はありません。
また、標準モジュールでブックの指定を省略した場合は「ActiveWorkbook」を、シートの指定を省略した場合は「ActiveWorkSheet」をそれぞれ指定したことになります。

よってどのブック、どのシートに対する処理なのか明示するようにしたほうがよいです。

■３
Findメソッドを使っていますが、いくつかの引数が省略されていますので場合によっては失敗しますから、きちんと指定されたほうがよいでしょう。

 ↓を参照
https://www.moug.net/tech/exvba/0150111.html

■４
おそらくループ処理の方法がわからなくてGotoラベルを多用してるのだとおもいますけど、あんまり一般的ではないと思います。
「■２」のことも相まって、本来は必要がないでしょう。

■５
ふまえるとこんな感じになりませんか？

    Sub macro1を整理()
        Dim MyPath As String, FileName As String
        Dim 発見セル As Range
        Dim r As Long, i As Long

        Stop 'ブレークポイントの代わり

        MyPath = ThisWorkbook.Path & "\"

        '▼自ブックの１番目のシートを対象にする
        With ThisWorkbook.Worksheets(1)

            '▼拡張子がpdfのファイルだけ探してループ処理
            FileName = Dir(MyPath & "*.pdf", vbNormal)
            Do While FileName <> ""
                r = r + 1

                '▼【A列に】リストアップ
                .Cells(r, "A").Value = FileName

                '▼【B列に】「#」以前の部分を書き出す
                .Cells(r, "B").Value = Left(.FileName, InStr(1, .FileName, "#") - 1)

                FileName = Dir()
            Loop

            '▼マシンIDを取り出す？
            .Range("C1").Value = Mid(.Range("A1").Value, InStr(.Range("A1").Value, "#") + 1)
            .Range("D1").Value = Left(.Range("C1").Value, InStr(1, .Range("C1").Value, ".") - 1)

            '▼ここからがファイル名のリストシートに〇をつける
            For i = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row
                Set 発見セル = ThisWorkbook.Worksheets(2).Range("B1").CurrentRegion.Find(What:=.Cells(.Rows.Count, "B").Value)

                If 発見セル Is Nothing Then
                    MsgBox "【" & .Cells(.Rows.Count, "B").Value & "】の検索に失敗"
                Else
                    発見セル.Offset(0, -1).Value = "〇"
                End If
            Next i

        End With

        MsgBox "完了しました"
    End Sub

（もこな２） 2020/08/16(日) 14:16

失礼。間違ってました。

誤

 ～.Find(What:=.Cells(.Rows.Count, "B").Value)
 MsgBox "【" & .Cells(.Rows.Count, "B").Value & ～

　　　　　　↓
正

 ～.Find(What:=.Cells(i, "B").Value)
 MsgBox "【" & .Cells(i, "B").Value & ～

（もこな２） 2020/08/16(日) 17:54

もこな2さん、ありがとうございます。
せっかく回答して頂いたので、使わせてもらったところ、以下の場所でエラーがでてしまいました。

                '▼【B列に】「#」以前の部分を書き出す
                .Cells(r, "B").Value = Left(.FileName, InStr(1, .FileName, "#") - 1)
なんで出てしまうのか？教えて下さい。お願いします。
（カトウ） 2020/08/18(火) 13:07

ごめんなさい。そこもミスしてますね。

 誤 .Cells(r, "B").Value = Left(.FileName, InStr(1, .FileName, "#") - 1)
 正 .Cells(r, "B").Value = Left(FileName, InStr(1, FileName, "#") - 1)

（もこな２） 2020/08/18(火) 13:15

コメント返信：

[ 一覧(最新更新順) ]

[[20200806185341]] 『ファイル名の書いてあるセル隣に○をつけたい』（カトウ） ページの最後に飛ぶ

[[20200806185341]]　『ファイル名の書いてあるセル隣に○をつけたい』（カトウ）　ページの最後に飛ぶ