こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

とあるシートの複数のセルの範囲の値と、とあるフォル

とあるシートの複数のセルの範囲の値と、とあるフォルダにあるファイル名が部分一致していたら、そのファイルを別の指定のフォルダに入れるVBAを大まかでいいので教えてください。

(1)アクティブになっているブック内にあるシートのとあるセル範囲のそれぞれの値(例:1111、2222、3333...)

(2)開いていないフォルダ内にあるファイル名(例:1111-H8-32.xlsなど)

が部分一致したとき、そのファイルを別のフォルダ内に移動させたいのですが、いまいちわかりません、教えていただけないでしょうか?

投稿日時 - 2020-08-31 08:01:56

QNo.9792718

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

(1.1)アクティブになっているブック
 ActiveWorkbook で捕まえる.

(1.2)ブック内にあるシートのとあるセル範囲のそれぞれの値
 For Each Next ループでセルの値を取得する.
 以下の処理は全てこのループの中で処理する.

(2.1)開いていないフォルダ内にあるファイル名
 Dir関数でフォルダ内のファイル名を順次取得して部分一致判定する.

(2.2)部分一致判定
 Instr関数で 1以上なら部分一致.
 比較するファイル名と比較する値は LCase関数か UCase関数で小文字か大文字に変換してから比較すること.

(2.2)ファイルを別フォルダ内に移動
 FileCopyでコピーしてからコピー元を Killで削除する.

投稿日時 - 2020-09-06 09:24:18

ANo.1

(1)使っていないシートのA列のセルに、その「開いていないフォルダ内」のファイル名を、すべて、書き出す。
またエクセルファイル以外は除くなど、「拡張子指定で除外が可能なら」、それもたやすい。

(2)そして「アクティブになっているブック内にあるシートのとあるセル範囲」の各セルをFor Each Nextで捉え、その文字列が、上述したファイル名の中に見つかるかどうか、ワイルドカード機能で、チェックする。
(3)該当なら、きまった別ホルダに移動する。
===
・Sheet2に書き出し例。
・"C:\Users\xx\Documents\  は指定ホルダに変えること。
http://officetanaka.net/excel/vba/filesystemobject/sample07.htm
より借用。
指定ホルダのファイル名をシートに書き出し例。
Sub test01()
Dim FSO As Object, f As Variant, BaseNames() As String, cnt As Long, i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
ReDim BaseNames(FSO.GetFolder("C:\Users\xx\Documents\").Files.Count)
For Each f In FSO.GetFolder("C:\Users\xx\Documents\").Files
If LCase(FSO.GetExtensionName(f.Name)) = "xlsx" Then
cnt = cnt + 1
BaseNames(cnt) = FSO.GetBaseName(f.Name)
End If
Next f
If cnt = 0 Then
MsgBox "xlsxファイルはありません", vbExclamation
Else
For i = 1 To cnt
Worksheets("Sheet2").Cells(i, 1) = BaseNames(i)
Next i
End If
Set FSO = Nothing
End Sub
ーーー
参考
https://excelwork.info/excel/findwildcard/
Sheet1のrange("b2:D3")(勝手例)にある文字列がSheet2のA列に見つかるか?
Sub test02()
k = 1
For Each cl In Worksheets("Sheet1").Range("b2:D3")
If cl <> "" Then
MsgBox cl
Set myrng = Worksheets("Sheet2").Range("A2:A500").Find(what:=cl & "*", LookAt:=xlWhole)
'---

If myrng Is Nothing Then
MsgBox "見つからず"
GoTo p1
Else
Worksheets("Sheet3").Cells(k, "A") = cl
Worksheets("Sheet3").Cells(k, "B") = myrng.Row
k = k + 1
End If
End If
p1:
Next
End Sub
(3)は略。WEB照会したら記事VBAコードが見つかります。
http://officetanaka.net/excel/vba/filesystemobject/filesystemobject23.htm
など。
==
質問者は、総体に、WEB照会をして、生かしきれてないようだ。
検索語さえ決められれば、普通の課題のコードなど、重要部分は、必ず見つかる。

投稿日時 - 2020-08-31 15:11:30

あなたにオススメの質問