• 締切済み

とあるシートの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

みんなの回答

  • HohoPapa
  • ベストアンサー率65% (454/691)
回答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

  • dell_OK
  • ベストアンサー率13% (740/5644)
回答No.2

現在の方法では簡単に 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

  • kon555
  • ベストアンサー率52% (1750/3357)
回答No.1

 既に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

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

  • 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が分かる方がいらっしゃいましたら、 是非ご教授お願いいたします。

  • 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~データがなくなるまで、 そのセルの値のフォルダを作成する。 になります。 よろしくお願いします。

  • ユーザー定義関数で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

  • 返ってくる値が違う

    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はフォルダの個数も取得されてるのですか?

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

    "名称"(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

  • セルの値でフォルダやファイル名とファイルの内容を

    セルの値で フォルダやファイル名とファイルの内容を一気に保存したいのですが、 どうしても式がわかりません。。 やりたいことはここにまとめてます。 ↓ http://bsmile.sakura.ne.jp/phptest/cc1.jpg 1 A列のフォルダと作って、 2 B行のファイル名で、 3 C行の内容のファイルを作りたいのです。 1については、 http://hamachan4.exblog.jp/10612140/ にある通り、 Dim mydir As String Dim i As Integer For i = 1 To Range("A" & Rows.Count).End(xlUp).Row mydir = "C:\Users\user\Desktop\test\" & Cells(i, 1).Value If Dir(mydir, vbDirectory) = vbNullString Then MkDir mydir Next i MsgBox "完了しました" End Sub フォルダを作る事はできそうなのですが、 2のフォルダパスをどう指定したらいいのか? (3はなんとなくできそうなですが、) で、色々みたんですが、どうしてもわからずで、 どういったVBAを組めばこの動作ができるでしょうか? どうかよろしくお願いいたします。 m(_ _)m

  • Excel VBAで文字列の部分一致の文字列を表示

    以前、こちらで頭5文字までの一致で文字列を表示するVBAを教えて頂きました。今回はFINDなどの部分一致での文字列を表示することをしたいのですが、ご教示いただけますと幸いです。 下記はSheet1のA3に文字を5文字以内いれるとSheet2のC列からピックアップしてSheet1のA列に文字列を表示する及びSheet2のB列のデータをSheet1のC列に表示させるVBAです。 Sub Test2() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim SData As String, i As Long, VRet As Variant Dim c As Range, LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") SData = CStr(Ws1.Range("A3").Value) If SData = "" Then Exit Sub i = 5 LastRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row If LastRow < i Then LastRow = i End If Ws1.Range(Ws1.Cells(i, "A"), Ws1.Cells(LastRow, "C")).ClearContents With Ws2 For Each c In .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)) VRet = InStr(1, CStr(c.Value), SData, vbTextCompare) If VRet = 1 And Len(c.Value) >= 10 Then Ws1.Cells(i, "A").Resize(1, 2).Value = c.Resize(1, 2).Value 'とりあえずSheet2のB列のデータ(C列のデータに同期したデータ)をSheet1のC列に Ws1.Cells(i, "C").Value = .Cells(c.Row, "B").Value i = i + 1 End If Next End With End Sub 宜しくお願い致します。

専門家に質問してみよう