• 締切済み
  • 困ってます

とあるシートのB列の値かつC列の値と、とあるフォル

とあるシートのB列の値かつC列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか? 現在、とあるシートのB列の値と、とあるフォルダ内にあるファイルの名称が部分一致した際に、そのファイルを移動先のフォルダへと移動させるVBAは作成することができました(以下参照) しかし、二つの条件(B列の値かつC列の値(AND?))が部分一致したときのやり方が分からなく困っております、VBA初心者のためどうか教えていただけないでしょうか? Sub 分別() '移動元のフォルダの設定 Const xFrm As String = "C:\before\"'移動先のフォルダの設定 Const xTo As String = "C:\after\"'アクティブになっているシートのB列の値とC:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する Dim i As Long, xFile As String With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row With .Cells(i, 2) xFile = Dir(xFrm &"*"&.Value &"*") Do While xFile <>""Name xFrm &xFile As xTo &xFile xFile = Dir() Loop End With Next i End With End Sub

共感・応援の気持ちを伝えよう!

  • 回答数3
  • 閲覧数78
  • ありがとう数0

みんなの回答

  • 回答No.3

示されたコードは、 B列の3行目のセルたちの先頭から順に読み その都度、指定のフォルダー内のファイルたちをチェックする というロジックのようです。 >現在の方法では簡単に And で判定することはできなさそうです。 私もそう思います。 むしろ、 指定のフォルダー内のファイルたちから1ファイルずつ取り出し そのファイル名に、 C列の文字列たちの何れかが含まれ、かつ、 D列の文字列たちの何れかが含まれるかをチェックし ヒットしたら移動する。という構造のほうが わかりやすいと思います。 Sub aaa()  Const xFrm As String = "C:\before\"  Const xTo As String = "C:\after\"  Dim xFile As String  xFile = Dir(xFrm & "*.*")  Do While xFile <> ""   If isHit(xFile) = True Then    'Debug.Print xFile    Name xFrm & xFile As xTo & xFile   End If   xFile = Dir()  Loop End Sub Function isHit(inText As String) As Boolean    Dim RowCnt As Long  Dim SW(3) As Boolean  Dim JobCnt As Long    isHit = False  SW(2) = False  SW(3) = False    For JobCnt = 2 To 3 'B列からC列まで   RowCnt = 3    '3行目から   Do    If Cells(RowCnt, JobCnt).Value = "" Then Exit Do    If InStr(inText, Cells(RowCnt, JobCnt).Value) > 0 Then     SW(JobCnt) = True     Exit Do    End If    RowCnt = RowCnt + 1   Loop  Next JobCnt    If ((SW(2) = True) And (SW(3) = True)) Then   isHit = True  End If End Function

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • 2つの列のANDで一致したファイルの移動

    とあるシートのB列の値かつAM列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、 そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか? この内容のVBAを作ったのですが、エラーが出てしまいます(エラーの箇所はコード内に示している)、またこのエラーが影響しているか分からないのですが分別されているのですが上手くいっていません VBA初心者なのでどうか分かりやすくお教えお願い致します Sub 分別() '移動元のフォルダの設定 Const xFrm As String = "C:\before\" '移動先のフォルダの設定 Const xTo As String = "C:\after\" 'アクティブになっているシートのB列の値かつAM列の値と、C:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する '((例)B列:M123456、AM列:789、C:\before内のファイル:M123456-789-C12.csv) Dim i As Long, xFile As String With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row With .Cells(i, 2) xFile = Dir(xFrm & "*" & .Value & "*") Do While xFile <> "" If xFile Like "*" & .Offset(, 37).Value & "*" Then Name xFrm & xFile As xTo & xFile End If xFile = Dir() Loop End With Next i End With 'C:\before内に残っているファイルを、C:\after2に移動 Dim fso As Object Dim MFir As String Dim SFir As String Set fso = CreateObject("Scripting.FileSystemObject") MFir = "C:\before\*.*" SFir = "C:\after2\" fso.MoveFile MFir, SFir →ここでエラー出る(実行時エラー53 ファイルが見つかりません) Set fso = Nothing MsgBox "終了" End Sub

  • ファイルを移動先のフォルダへ移動させるVBA教えて

    とあるシートのB列の値かつAM列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、 そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか? この内容のVBAを作ったのですが、エラーが出てしまいます(エラーの箇所はコード内に示している)、またこのエラーが影響しているか分からないのですが分別されているのですが上手くいっていません VBA初心者なのでどうか分かりやすくお教えお願い致します Sub 分別() '移動元のフォルダの設定 Const xFrm As String = "C:\before\" '移動先のフォルダの設定 Const xTo As String = "C:\after\" 'アクティブになっているシートのB列の値かつAM列の値と、C:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する '((例)B列:M123456、AM列:789、C:\before内のファイル:M123456-789-C12.csv) Dim i As Long, xFile As String With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row With .Cells(i, 2) xFile = Dir(xFrm & "*" & .Value & "*") Do While xFile <> "" If xFile Like "*" & .Offset(, 37).Value & "*" Then Name xFrm & xFile As xTo & xFile End If xFile = Dir() Loop End With Next i End With 'C:\before内に残っているファイルを、C:\after2に移動 Dim fso As Object Dim MFir As String Dim SFir As String Set fso = CreateObject("Scripting.FileSystemObject") MFir = "C:\before\*.*" SFir = "C:\after2\" fso.MoveFile MFir, SFir →ここでエラー出る Set fso = Nothing MsgBox "終了" End Sub

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

    とあるシートの複数のセルの範囲の値と、とあるフォルダにあるファイル名が部分一致していたら、そのファイルを別の指定のフォルダに入れるVBAを大まかでいいので教えてください。 (1)アクティブになっているブック内にあるシートのとあるセル範囲のそれぞれの値(例:1111、2222、3333...) (2)開いていないフォルダ内にあるファイル名(例:1111-H8-32.xlsなど) が部分一致したとき、そのファイルを別のフォルダ内に移動させたいのですが、いまいちわかりません、教えていただけないでしょうか?

  • 回答No.2
  • dell_OK
  • ベストアンサー率10% (487/4537)

現在の方法では簡単に And で判定することはできなさそうです。 B列の値を含むファイル名を Dir で取得しているので、その後でそのファイル名がC列の値を含むかどうかの判定を付加するようになると思います。 あるいは、B列C列の順で含まれているのであれば、 まず、これをやめて、  With .Cells(i, 2) ファイルの取得をこんな風にしてみる。  xFile = Dir(xFrm & "*" & .Cells(i, 2).Value & "*" & .Cells(i, 3).Value & "*") 試してないのでできるかどうかわかりません。 他の方法としては、 フォルダ内のファイルがすごく多いのでなければ、すべてのファイルを取得して、そのファイル名がB列およびC列の値を含んでいるか判定した方がわかりやすいかと思います。 Dim xB As String Dim xC As String xB = "*" & .Cells(i, 2).Value & "*" xC = "*" & .Cells(i, 3).Value & "*" If xFile Like xB And xFile Like xC Then

共感・感謝の気持ちを伝えよう!

  • 回答No.1
  • kon555
  • ベストアンサー率53% (686/1271)

 既に1つの条件で分岐させて目的の動作が行えているなら、後は書き方だけの問題ですね。仰るようにAND条件で分岐させればいいと思います。  具体的なやり方は以下のページなどをどうぞ https://www.forguncy.com/blog/20180925_vbaandornot https://akira55.com/andornot/  あとはAND文を使わなくとも、 if (B列とファイルの名称が部分一致) then  if (C列とファイルの名称が部分一致) then ファイル移動 endif  という書き方でも達成できます。 (参考ページ)https://www.officepro.jp/excelvba/if/index4.html  あまり複雑になると厄介ですが、個人的にはこちらの書き方の方が分かりやすくて好きですね。

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • ユーザー定義関数でA列の値に応じてB列の値を変える

       A列      B列 1行   Type   名称 2行     1    あ 3行    2    い 4行    3    う VBA初心者のものです。ユーザー定義関数を作成して、A列のTypeの値に応じて、B列の名称の値を変化させる式を作成中です。B列2行目に、下記のユーザー関数をセル式として記述し、3・4行目にコピーしたのですが、0が表示されてしまいます。 どうしてでしょうか? Functionめいしょう(Type, 名称) Sheets("突合せ").Select If  Type = 1 Then 名称 ="あ" Exit Function     If  Type = 2 Then   名称 = "い"   Exit Function        If  Type = 3 Then        名称 = "う"           Exit Function       End If     End If End If End Function

  • ある文字を含む列と同じ行にある列と一致の文字の除外

    "名称"(D列)で*ABCD*と含まれるものと同じ行にある"番号"(B列)が一致するものを全て除外したい(D列の値は異なるが、 B列の値が一緒なものを除外したい)。 下記のコードに上記の内容のコードを加えたいのですがやり方を教えていただけないでしょうか? ちなみにVBA初心者なためお手柔らかにお願い致します。 Sub 分別() Dim j As Long j = Cells(Rows.Count, 1).End(xlUp).Row With Range(Cells(3, 1), Cells(j, 43)) .AutoFilter Field:=37, Criteria1:="EFGK" .AutoFilter Field:=4, Criteria1:="*FF0001*", Operator:=xlOr, Criteria2:="*DD0002*" End With End Sub

  • A列の値を元にフォルダを作成するVBAの質問です

    A列の値を元にフォルダを作成するVBAで 富士通の緑の本を参考にして作ってみたのですが、 うまく動作しません。 1.Sub フォルダ作成() 2. 3. Dim MyFSO As New FileSystemObject 4. Dim Folderpath As String 5. Dim i As Integer 6. 7. i = 1 8. 9. Do While Cells(i, 1).Value <> "" 10. 11. Folderpath = ThisWorkbook & "\Cells(i, 1).value" 12. 13. MyFSO.CreateFolder Path:=Folderpath 14. 15. i = i + 1 16. 17. Loop 18. 19.Set MyFSO = Nothing 20. 21.End Sub 目的の動作は 今のワークブックのある場所にSheet1のA列の1&#65374;データがなくなるまで、 そのセルの値のフォルダを作成する。 になります。 よろしくお願いします。

  • Excel VBA でテキストボックスの値をセルA列から検索

    いつもお世話になります。 Private Sub CommandButton3_Click() Dim 行 As String Dim 列 As String Dim 最終行 As String Dim 検索行 As String Dim メッセージ As Integer Dim 一致 As Range Dim myNO As Variant Dim i As Long Sheets(3).Select 最終行 = Range("A2").End(xlDown).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column myNO = TextBox2.Value 検索行 = Range("A2").End(xlDown).Select ※・・・Set 一致 = Range("A2:検索検").Findwhat:=TextBox2,lookat:=xlWhole) If 一致 Is Nothing Then MsgBox "データがありません。新規コード入力します。" Cells(行, 列 + 0) = UserForm1.TextBox2.Value Cells(行, 列 + 1) = UserForm1.ComboBox7.Value Else i = Cells(行 - 1, "A") Cells(i, 列 + 0) = UserForm1.TextBox2.Value Cells(i, 列 + 1) = UserForm1.ComboBox7.Value End If End Sub 「エラー1004'Range'メソッドは失敗しました'Global'オブジェクト」とでます。※印が黄色になっています。 ユーザーフォーム1のテキストボックスの値をシート3のA列から検索して、一致すれば、A列の一致セルに上書き入力して、一致が無い場合はA列の空白セルに追加入力したいのです。よろしくお願い致します。

  • エクセルVBA:取得したファイル情報を別シートに貼るには・・・

    いつもお世話になっています。 今エクセルVBAで指定したフォルダ内のファイル情報を取得し、sheet2に貼り付けるものを作っています。 指定したフォルダ内のファイル情報を取得するまでは分かったのですが、作ったVBAを実行するとsheet1のA2セルから自動的に貼り付けられてしまいます。 sheet2のA1セルから貼り付けるにはどうすれば良いのでしょうか?? 作ったVBAはこんな感じです。 まず、フォルダのパスを取得しA2セルへ表示します。 Sub test2()  With Application.FileDialog(msoFileDialogFolderPicker) If .Show = 0 Then Exit Sub Range("A2").Value = .SelectedItems(1) End With End Sub 次に、A2セルの値を使ってファイル名を取得しました。 Sub Test() Dim i As Long Dim pass As String pass = Range("A2").Value With Application.FileSearch .NewSearch .LookIn = pass .FileType = msoFileTypeAllFiles .SearchSubFolders = True If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Cells(i + 1, 1) = .FoundFiles(i) Cells(i + 1, 3) = FileDateTime(.FoundFiles(i)) Next i End If End With End Sub です。 長くて申し訳ありません。よろしくお願いします。

  • B列の値を参照して、A列に連番を振る方法

    A・B・C列があり、A列には連番を、B列にはVLOOKUP関数が入っており、 C列には、B列の検索値が入っております。 B列は下記のVBAコードで同じ値をセル結合させています。 Sub 結合() Dim rngU As Range Dim i As Range Dim rngB As Range Dim Key As String Set rngB = Range("B2") Set rngU = Range(Range("B3") _ , Range("B6000").End(xlUp).Offset(1)) Application.DisplayAlerts = False For Each i In rngU If Not i.Text = Key Then If (Not i.Offset(-1) Is rngB) And _ (Not i Is rngB) Then Range(rngB, i.Offset(-1)).MergeCells = True End If Set rngB = i End If Key = i.Text Next i Application.DisplayAlerts = True End Sub そこで、A:3から連番を振りたいのですが、B列の決まった特定の結合セルの 隣のA列のセルもB列の決まった特定の結合セルと同数にセル結合させ、 連番を1つとしてカウントしたいのです。 また、A列にはB列同様にVLOOKUP関数が入っており、連番を振りたくないセルには 印が付くようにしています。 行数やB列の決まった特定の結合セル番地はランダムに変わるため、B列の結合セルで参照させるしか ないのかなっと思っております。 B列の特定の結合セルの値は決まっております。 上記のような処理を自動にさせるためのVBAが分かる方がいらっしゃいましたら、 是非ご教授お願いいたします。

  • VBAで任意のフォルダ内のファイルの特定の文字列を

    お世話になります。今、Excelを使用しVBAで任意のフォルダ内に含まれるファイル(txt形式ですが拡張子はありません)から、特定のA&#65374;Bの部分の文字列のみを抜き出し、ExcelのSheetに出力させるというVBAを作成しようと考えています。また、A&#65374;Bで抽出した文字列内に”空白”が含まれる場合、その空白でセルを隔てるという処理を加えたいです。 また、それらとは別に任意のフォルダ内に含まれるファイルのファイル名のみを抽出し、Excelに出力するというVBAも作ろうと考えています。 私自身、これまでExcelでは関数を使うのが精一杯でVBAの勉強すらしてきませんでしたので、だいぶ困窮しております。 どなたか、VBAについて詳しい方、ご教授いただけたら幸いです。 以下は、参考までに、特定のフォルダ内に含まれるファイルをSheetに出力するVBAになります。 ここからさらに、任意の文字列を検索し、抽出し、出力する機能と、また空白部分でセルを分ける機能、またファイル名一覧を抽出する機能を加えていきたい所存です。 どなたか、お力添えの程何卒よろしくお願い致します。 Sub GetAllFile() Dim buf As String, tmp As Variant, cnt As Long, i As Long Dim myFol As String, myFile As String Dim fNo As Integer, myCol As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "*** 対象フォルダを選択し、[OK]をクリック ***" .InitialFileName = "C:\" If .Show = True Then myFol = .SelectedItems(1) End If End With myFile = Dir(myFol & "\*") myCol = 0 Do While myFile <> "" fNo = FreeFile Open myFol & "\" & myFile For Input As #fNo Do Until EOF(fNo) Line Input #fNo, buf tmp = Split(buf, ",") cnt = cnt + 1 For i = 1 To UBound(tmp) + 1 Cells(cnt, i + myCol) = tmp(i - 1) Next i Loop Close #fNo myFile = Dir() myCol = myCol + 4 cnt = 0 Loop End Sub 上記、VBAは動作はしましたが、やはりフォルダ内のファイル数の数により、途中でフリーズしてしまう事もありました。ご教授の程、何卒よろしくお願い致します。

  • 選択ファイル(フルパス名)をアクティブセルから表示

    ダイアログボックスが自動的に開き選択ファイル(フルパス名) が表示されるVBEがあるんですが、(下記参照)改良したい点がありますので見て下さい。 Sub Excelファイル() Dim i As Integer Dim xFileNames As Variant, xFile As Variant, xDir As String With Application.FileDialog(msoFileDialogFilePicker) xFileNames = Application.GetOpenFilename( _ FileFilter:="Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", MultiSelect:=True) If IsArray(xFileNames) Then i = 1 For Each xFile In xFileNames 'Xファイルネーム(フルパス名)すべての要素に同じ処理を繰り返す xDir = Dir(xFile) '変数xDir=xファイル名(ファイル名) If i = 1 Then 'i=1の場合(選択ファイル一つ目の場合) Cells(i, 1).Value = Replace(xFile, xDir, "") 'A列の中にフルパスからファイル名を取り除いた値を表示する Cells(i, 1).Offset(1).Value = xDir '1行下の値がファイル名である。 i = i + 2 'iに2を加えてループ Else '違う場合 Cells(i, 1).Value = xDir 'A列に順にファイル名を表示する i = i + 1 'iに1を加えてループ End If Next xFile 'xファイルに戻る End If Cells(Rows.Count, 1).End(xlUp).Offset(1).Activate 'データの最終行をA列で検知して一つ下の行がアクティブセル End With End Sub この命令文だとA1セルから縦に順にフルパス名が表示され、データの最終行の一つ下がアクティブセルになるようになっています。 改良したい点は、A列限定ではなくアクティブセルから順に上記と同じようにフルパス名が表示され、データの最終行の一つ下にアクティブセルがくるVBEに改良したいです。 ※上記VBEのようにアクティブセルに選択ファイル一つ目のフルパスからファイル名を取り除いたデータを表示し、   Offset(1,0)に選択ファイル一つ目のファイル名のみを表示、Offset2以降は選択ファイル2つ目以降のファイル名だけを表示するようにする。 VBA初心者なので、上記のようにそれほど難しくない構文で仕上げたいのですが、 もしできる方いましたら教えてください。 よろしくお願いいたします。

  • 返ってくる値が違う

    VBAでフォルダの中のファイルの個数を取得するコードなのですが Sub test1() Dim i As Long, buf, Path As String Path = ActiveWorkbook.Path & "\" buf = Dir(Path & "*.*") Do While buf <> "" i = i + 1 buf = Dir() Loop MsgBox "「" & ActiveWorkbook.Path & "」には、全部で" & i & "個のファイルがあります。" End Sub Sub test2() Dim Path As String Dim i As Long, FSO As Object, f As Object Path = ActiveWorkbook.Path & "\" Set FSO = CreateObject("Scripting.FileSystemObject") MsgBox "「" & ActiveWorkbook.Path & "」には、全部で" & FSO.GetFolder(Path).Files.Count & "個のファイルがあります。" Set FSO = Nothing End Sub Test1とtest2では返ってくる値が違うのですが なぜでしょうか? Test2はフォルダの個数も取得されてるのですか?

  • 属性の値に特殊文字が大量にあるとMSXMLで読み込めない

    MSXMLを使って、属性の値に特殊文字(「<」「>」「&」など)が 大量に使われているXMLを読みこもうとすると失敗します。 正常なXMLと認識されないようです。 「Load」を使ってファイルから読み込んだ場合もダメ。 「LoadXML」で文字列から読み込んだ場合もダメ。 以下のようなVBAコードで再現できます。 --------- Dim oDom As New MSXML2.DOMDocument With oDom.appendChild(oDom.createElement("root"))   With .Attributes.setNamedItem(oDom.createAttribute("attr"))     '.nodeValue = String(65533, "<") 'OK     .nodeValue = String(65534, "<") 'NG   End With End With oDom.loadXML oDom.XML '←正しく読み込めない --------- MSXML4でもMSXML6でも同様でした。 これはバグ、それとも仕様なのでしょうか。 探してもそれらしい資料が見つかりません。 どなたかわかる方、教えてください。 補足ですが、 実は同様のXMLファイルをIE6に読ませようとした場合にも、エラー表示されます。 エラーメッセージは「エラーを特定できません」。 FireFoxだとOKのようです。

    • 締切済み
    • XML