[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイル名の書いてあるセル隣に○をつけたい』(カトウ)
はじめまして。
マクロ初心者ですので、ご了承下さい。
たとえば、複数の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
セルのループの参考HPです。
http://excel-mania.com/vba/for_next4.html
(OK) 2020/08/06(木) 19:28
逆に、フォルダ内のファイル一覧を取得し、Findメソッドで 指定のセル範囲の中にファイル名と一致するセルが存在 するか否かを判定する、という方法も。 (OK) 2020/08/06(木) 20:49
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
■1
↓のように記述すると、「ThisPath」はVariant型を指定したことになります。
Dim ThisPath, FileName As String
なので、String型にしたい場合は。↓のようにします。
Dim ThisPath As String, FileName As String
■2
原則として、VBAの世界では「ブック」、「シート」や「セル」などをきちんと明示すればいちいち選択したりアクティブにしたりする必要はありません。
また、標準モジュールでブックの指定を省略した場合は「ActiveWorkbook」を、シートの指定を省略した場合は「ActiveWorkSheet」をそれぞれ指定したことになります。
よってどのブック、どのシートに対する処理なのか明示するようにしたほうがよいです。
■3
Findメソッドを使っていますが、いくつかの引数が省略されていますので場合によっては失敗しますから、きちんと指定されたほうがよいでしょう。
↓を参照 https://www.moug.net/tech/exvba/0150111.html
■4
おそらくループ処理の方法がわからなくてGotoラベルを多用してるのだとおもいますけど、あんまり一般的ではないと思います。
「■2」のことも相まって、本来は必要がないでしょう。
■5
ふまえるとこんな感じになりませんか?
Sub macro1を整理() Dim MyPath As String, FileName As String Dim 発見セル As Range Dim r As Long, i As Long
Stop 'ブレークポイントの代わり
MyPath = ThisWorkbook.Path & "\"
'▼自ブックの1番目のシートを対象にする 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
(もこな2) 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 & 〜
(もこな2) 2020/08/16(日) 17:54
'▼【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)
(もこな2 ) 2020/08/18(火) 13:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.