[[20230927101159]] 『「VBA」複数Excelシートを複数ブックに仕分ける方』(ぽいたろう) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『「VBA」複数Excelシートを複数ブックに仕分ける方法』(ぽいたろう)

いつも掲示板を拝見させていただきまして、参考にさせております。
VBAは初心者で、コピーしながら変更して使用しているのですが、現在行っているコードが上手くいかなくて困っております。

【結果的にしたいこと】
1つのフォルダ内に Excel ブック が200件(個々の研修結果のデータ)があり、20部署のファイルに一気に仕分けたいです。

現在、ある方のコードをそのまま利用しました。事前準備で
1:新しいファイルにそれぞれ20部署のファイルを作成。
2:新しいファイル内に『200件のExcel』ブックを入れる。
3:仕分けを実行するマクロExcelを作成し、
  A列に『200件のExcelの名前』、B列に「仕分け番号」を記入(1.2.3...)の表を作成。
4:下記のコードを入れて、実行

  [A列]  [B列]

  『名前』 「仕分け番号」    ファイル名
1  阿部   3          営業課
2  伊藤   2          事務課
3  上野   3          営業課
4  江原   1          経理課
5  大川   2          事務課

Sub 仕分け()

    '変数の型を宣言
    Dim file_name As String
    Dim i As Integer
    'A列が空欄になるまで繰り返し処理を実施
    Do Until Cells(2 + i, 1) = ""
        file_name = Cells(2 + i, 1)
        '仕分け番号が1の場合
        If Cells(2 + i, 2) = 1 Then
        Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name
        Else
        '仕分け番号が2の場合
        If Cells(2 + i, 2) = 2 Then
        Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\事務課\" & file_name
        Else
        '仕分け番号が3の場合
        If Cells(2 + i, 2) = 3 Then
        Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\営業課\" & file_name
        End If
        End If
        End If
        i = i + 1
    Loop
End Sub

ちなみに最初のこの部分でエラーが発生します。(エラー53:ファイルが見つかりません)

        If Cells(2 + i, 2) = 1 Then
        Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name

20部署あるので増やしていけばいいと記入があったのですが、
このコードからつまづいたので、もし気付いたことや、
他に違うコードがありましたらご教授いただけますと幸いです。
お返事は翌日になる可能性があります。よろしくお願いいたします。

< 使用 Excel:Microsoft365、使用 OS:Windows10 >


 最初の方でつまずいて先に進む気力がなくなった。

>1:新しいファイルにそれぞれ20部署のファイルを作成。
>2:新しいファイル内に『200件のExcel』ブックを入れる。

 ファイルにファイル? ファイルにブック?
(xlg) 2023/09/27(水) 10:24:45


 ちょっとだけ先まで読んでみたが、

>ちなみに最初のこの部分でエラーが発生します。(エラー53:ファイルが見つかりません)
> If Cells(2 + i, 2) = 1 Then
> Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name

 Name?? 何がしたいの?
(xlg) 2023/09/27(水) 10:34:46


 > file_name = Cells(2 + i, 1)

まずこれですが、宣言されたばかりのiはたぶん0ですね。
するとCells(2,1)からスタートになりますが、阿部さんスキップしてませんか?
番号の付け方が悪いだけでCells(1,1)にタイトル行があるなら問題ありません。

 >Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name

名前を変更しようとしていますが、file_nameには「阿部」とか入ってますよね。
「阿部」って名前のファイルはないですよね?だから、ファイルがないと言われてるのでは?
あるとしても、「阿部.xlsx」とかではないでしょうか?
(ゆたか) 2023/09/27(水) 10:38:12


 Name ってリネームのことだったのか、知らんかった(使ったことねーし、使うこともなさげだが)。

>するとCells(2,1)からスタートになりますが、阿部さんスキップしてませんか?

 ここはパッと見同じことを思いましたが、1 行目は見出しがあんだろうと勝手に解釈しました。
(xlg) 2023/09/27(水) 10:42:18


>1:新しいファイルにそれぞれ20部署のファイルを作成。
>2:新しいファイル内に『200件のExcel』ブックを入れる。
3:と関連するようにそれぞれファイル名を示さないと分かりませんよ。
それによってマクロの内容も変わってきます。

(マクロ苦手) 2023/09/27(水) 11:33:04


一旦流れを整理されてはどうでしょうか?想像するに
 1. 1つのフォルダ内に【担当の名前になっている】ブック(ファイル)が200個ほどある
 2. ↑を【マクロブック】に用意した【担当者と所属部署の対応表】に基づき
 3. 1のフォルダから所属部署のフォルダへ【ファイルを移動させたい】

ということではないですか?そういう話であれば、

 1. フォルダ内のファイルを巡回し、拡張子が【.xls?】ならば担当者名を調べる
 2. 「1」で調べた担当者の所属部署を対応表で調べる
 3. 「2」で調べた部署のフォルダへ「1」のファイルを移動する

という動きを繰り返しすればよいので、『200件のExcelの名前』「仕分け番号」といったものはいらないように思われます。

(もこな2 ) 2023/09/27(水) 12:06:50


xlg様

他の作業に追われながら進む気力がなくなったのは事実です。
みなさんの知恵でしたらコードが間違っているのがすぐ分かるのかと思ってお力をお借りしようといたしました。
そして、ファイルではなくフォルダーでした。申し訳ありません。
最後に仰ってくださった
>1 行目は見出しがあんだろうと勝手に解釈しました。
その通りでございます。

ゆたか様
新しいフォルダー内にExcelの名前で「阿部」というのはあるのですが、
そのExcelの名前自体に「.xlsx」が必要ということでしょうか?

マクロ苦手様
私の説明が下手で申し訳ありません。

もなこ2様
流れを整理していただいてありがとうございます。
この形でしたら再度調べてできそうな気がしてきました。

(ぽいたろう) 2023/09/27(水) 12:57:01


もこな2様でした。名前間違えて申し訳ありません
(ぽいたろう) 2023/09/27(水) 13:17:03

お返事をいただいたようですが、書いちゃったので投稿しておきます。
質問内容から考えると↓のようなことも考えられます。

【Bパターン】

 #ファイル名で移動先フォルダが判断できるが規則性がなく人間が確認して判断する必要がある場合
  1. ファイル名をリストアップする(マクロ1)
  2. 人の手で移動先フォルダを決定する(手作業)
  3. リストに沿ってファイルを移動する(マクロ2)

【Cパターン】

 #ファイル名で所属部署が判断でき、所属部署ごとのブックごとに取りまとめたい
 1. ファイル名から、所属部署をしらべる
 2. (開いてなければ)所属部署のブックを開く
 3. 「1」のシートをコピーして↑の末尾に挿入する

なので、まずはやりたいことを正確(フォルダ、ブック(ファイル)、シートなどを明確)にして箇条書きで整理されてはどうですか?

(もこな2 ) 2023/09/27(水) 13:23:27


 >新しいフォルダー内にExcelの名前で「阿部」というのはあるのですが、
 >そのExcelの名前自体に「.xlsx」が必要ということでしょうか?

Windowsの標準設定では既知の拡張子(.txtとか.xlsxとか、.より後の部分)は省略されます。
よって、「阿部.xlsx」というファイル名は「阿部」とのみ表示されます。

設定を変更して拡張子を調べてください。新しく作ったのなら.xlsxだと思いますが、
古いファイルを引き継いでいれば、.xlsの場合もありますし、
情報交換用のファイルなら.csvのこともあります。

参考
https://pc-karuma.net/windows-10-show-explorer-file-name-extension/

(ゆたか) 2023/09/27(水) 14:32:04


で、マクロにも拡張子を追加します

例)

file_name → filename & ".xlsx"

P.S.

現在はセルに名前を入力して一つずつファイル名を指定していますが、
そのフォルダにあるすべてのファイルを対象にして順次処理していくこと
もできます。ただし、名前と所属の対応はどこかで必要となりますね。

現在はif分をネストしていますが、Select Caseとかを使えば読みやすくなります。
まあ、動けば良いという考え方もあるかとは思います。
(ゆたか) 2023/09/27(水) 14:43:10


 もし一回きりの作業でたかだか 200 ファイルだったら、悩んでいる間にエクスプローラで仕分けられそうな、とこれを言ったら元も子もないか。
(xlg) 2023/09/27(水) 15:30:24

もこな2様
2パターンを想定してご教授していただきありがとうございます。

ゆたか様
ご丁寧にURLありがとうございます。.xlsxでした。
>そのフォルダにあるすべてのファイルを対象にして順次処理していくこともできます。
この方法も良いと思いますので、調べてみます。

xlg様
まさにその通りなのですが、今後のことも考えてVBAに手を出しました(-_-;)

今回この方のようにしたかったのですが、伝わらなくて申し訳ありません。
(最初からURL乗せておけばよかったです><)
https://www.higashisalary.com/entry/file-sorting
違う視点を得られたのでこの情報を基に違う方法も考えてみます。
良い方法がありましたら、ご教授いただけますと幸いです。頼りっぱなしで申し訳ありません。

(ぽいたろう) 2023/09/27(水) 17:34:42


書いている間に追加コメントがありましたがそのまま。

質問と関係ないことも含め何点か。

■1
↓は、やってることとコメントが一致していません

 Set r = .Cells(8, 4).CurrentRegion 'D列8行目にフィルタ

さらに言うと、【r】に格納されるのは【D8セルが"含まれる"表範囲】であって【D列8行目以下のセル範囲】ではありません。

■2
>D列に〜というデータがあるとき
提示のような並びであればそれなりに幸せな結果になると思いますが、D列(の初めのほうに)重複があれば↓は破綻しませんか?

 r.AutoFilter 4, r(i, 4)

■3
>オートフィルターの切り替えをループする
↑の意味が、【実行する(ボタンを押す)】たびに【抽出条件】を【一定のパターン】の範囲で変わるようにしたいという話ならば以下のように考えてみてはどうでしょうか?

 1. オートフィルタ自体は手動で設定
 2. 【別シート】のA列にリストを用意しておく(データをコピペして重複の削除をすればok)
 3. 以下のマクロを研究して、適宜カスタマイズ
    Sub さんぷる()
        Stop 'ブレークポイントの代わり
        Static i As Long
        Dim 順番 As Long
        Dim 抽出条件 As String

        i = i + 1
        With Worksheets("別シート")
            順番 = i Mod (.Cells(Rows.Count, "A").End(xlUp).Row + 1)

            If 順番 = 0 Then
                抽出条件 = "<>"
            Else
                抽出条件 = .Cells(順番, "A").Value
            End If
        End With

        Debug.Print i & "回目の実行です" & vbLf & "リスト" & 順番 & "番目の条件は【" & 抽出条件 & "】です" & vbLf
        'ここにオートフィルタで抽出する命令を記述
    End Sub

なお、オートフィルタが設定されている範囲は↓で取得できます。

 【ワークシートオブジェクト】.Autofilter.Range

(もこな2 ) 2023/09/27(水) 17:40:57


失礼。↑は投稿先誤りです。無視してください。

(もこな2 ) 2023/09/27(水) 17:46:15


もこな2様

本当に考えて下さりありがとうございます><
返信が遅くなって申し訳ありません。

(ぽいたろう) 2023/09/27(水) 17:58:03


先ほどは失礼しました。
お話を伺うに、やはりBパターンのようなことなのではないでしょうか?

    Sub リストアップ()
        Dim フォルダ As String, ファイル名 As String
        Dim 行 As Long

        フォルダ = "C:\hogehoge\"
        ファイル名 = Dir(フォルダ & "*.xls?")
        Do Until ファイル名 = ""
            行 = 行 + 1
            ActiveSheet.Cells(行, "A").Value = ファイル名
            ファイル名 = Dir()
        Loop
    End Sub
    '=============================
    Sub リネーム()
        Dim フォルダ As String
        Dim 行 As Long

        フォルダ = "C:\hogehoge\"
        With ActiveSheet
            For 行 = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
                Debug.Print フォルダ & .Cells(行, "A").Value
                Debug.Print "   ↑を↓にリネーム"
                Debug.Print フォルダ & .Cells(行, "B").Value & "\" & .Cells(行, "A").Value
                Debug.Print
            Next
        End With
    End Sub

(もこな2 ) 2023/09/27(水) 18:41:34


ところで、今回はExcelのマクロを使ってファイルを指定のフォルダに移動させています。

へーえ、なんかすごいことやってるなあ。。。

ん?待てよ?えっ、こんなことExcelのマクロでやる必要あるんだっけ?

というわけで、今更なんですが。。。

1.移動させたいファイルのあるフォルダにテキストファイルを1つ作成します。

ファイル名は「移動.txt」とでもして、内容は以下の通り(5行)とします。


move 阿部.xlsx 営業課
move 伊藤.xlsx 事務課
move 上野.xlsx 営業課
move 江原.xlsx 経理課
move 大川.xlsx 事務課

※保存するときに文字コードはANSIにしてください(既定値のUTF-8ではうまく動作しません)

2.拡張子を変更します

ファイル名を「移動.txt」から「移動.bat」に変更します。

3.そのファイルをダブルクリックします

以上です。

いずれにしても、名前と所属の関係を管理する必要があるなら、この方が簡単じゃないですか?
(ゆたか) 2023/09/28(木) 09:23:21


なお、上記で所属を示すフォルダはすでに作成されていることを想定しています。

フォルダがない状態で実行すると、エクセルブックがフォルダ名になり、さらに上書きされます。
(データは常にバックアップを取るようにしましょう)

もし、フォルダも同時に作りたければ、先頭に

mkdir 営業課
mkdir 事務課
mkdir 経理課

の3行を付け加えてください。

P.S.

なお、拡張子が.batのファイルはバッチファイルと呼ばれていて、いろんな処理ができます。

以下のようなバッチファイルを作ると、ディレクトリにある拡張子が.xlsxのファイル一覧を一覧.txtに書き込んでくれます。

dir /B *.xlsx > 一覧.txt
(ゆたか) 2023/09/28(木) 11:06:58


  もこな2様
  コードありがとうございます。
  Bパターンで一度作成してみます!!

  ゆたか様
  ご教授いただいた方法で実行してみました。できました。
  ありがとうございます!
  
(ぽいたろう) 2023/09/28(木) 11:29:14


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.