Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7099 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【41185】ファイル名のオートナンバー もとあし 06/8/1(火) 16:37 質問[未読]
【41188】Re:ファイル名のオートナンバー Blue 06/8/1(火) 17:01 質問[未読]
【41189】Re:ファイル名のオートナンバー Kein 06/8/1(火) 17:07 回答[未読]
【41197】Re:ファイル名のオートナンバー ハチ 06/8/1(火) 17:54 発言[未読]
【41213】Re:ファイル名のオートナンバー もとあし 06/8/2(水) 9:39 お礼[未読]
【41223】Re:ファイル名のオートナンバー ハチ 06/8/2(水) 12:50 発言[未読]
【41226】Re:ファイル名のオートナンバー もとあし 06/8/2(水) 14:46 お礼[未読]
【41185】ファイル名のオートナンバー
質問  もとあし  - 06/8/1(火) 16:37 -
引用なし
パスワード
   こんにちは。
最近エクセルのマクロを始めた者です。

ブックAから必要な部分のみブックBに抽出し、ブックBをブックAの入っているフォルダと同じ階層の別フォルダ内に保存したいのですが、保存の際のファイル名で悩んでいます。

ブックAより異なる抽出条件でブックB、ブックCと出来てくるので、「ブックAのファイル名」＋「オートナンバー」のような形にしたいのです。

下記記述の保存ファイル名は、オートナンバーではなく「/」を省いた日付を最後に持ってくるようにしていますが、できましたらオートナンバーのようにしたいのです。

例えば、保存先フォルダ内の似通ったファイル名の末尾の最終番号を見つけて、ファイル名に指定するなどという方法、もしくはもっと良い方法はあるのでしょうか？

分かる方がいらっしゃれば教えていただければと思います。
よろしくお願いします。


Dim MyPath As String
Dim MyBook As String

MyPath = Replace(ActiveWorkbook.Path, "フォルダA", "フォルダB")
MyBook = Replace(ActiveWorkbook.Name, ".xls", "")

Workbooks("ブックB").SaveAs Filename:=MyPath & "\" & MyBook & "_" & Year(Date) & Month(Date) & Day(Date) & ".xls"
【41188】Re:ファイル名のオートナンバー
質問  Blue  - 06/8/1(火) 17:01 -
引用なし
パスワード
   ということは、フォルダBに
「ブックAのファイル名」というファイルがない場合
は

XXXXXX_1.xls

すでに、ある場合は、あるファイルの連番になるようにしたい。
たとえば

XXXXX_1.xls
XXXXX_2.xls
XXXXX_3.xls

とあったら XXXXX_4.xls としたいということでしょうか？
そのとき、欠番は考慮するのでしょうか？

> 例えば、保存先フォルダ内の似通ったファイル名の末尾の最終番号を見つけて、
> ファイル名に指定するなどという方法、もしくはもっと良い方法はあるのでしょうか？
おそらく、このような感じになるでしょうね。
ただ、フォルダ配下のファイル列挙するときに、ファイル名でソートされているわけではないので、
注意しないといけませんけど。
【41189】Re:ファイル名のオートナンバー
回答  Kein  - 06/8/1(火) 17:07 -
引用なし
パスワード
   Sub Add_BookNum()
　 Dim WB As Workbook
　 Dim MyF As String, SvF As String, NewFN As String
　 Dim Fnum As Integer
　
　 MyF = Application _
　 .GetOpenFilename("Excelブック(*.xls),*.xls")
　 If MyF = "False" Then Exit Sub
　 Set WB = Workbooks.Open(MyF)

　 'ここにマクロ実行ブック(ブックA)から、開いたブック(WB)への
　 'データ転記処理コードを入れる。
　　
　 SvF = Replace(ThisWorkbook.Path, "フォルダA", "フォルダB")
　 With Application.FileSearch
　　　.LookIn = SvF
　　　.FileType = msoFileTypeExcelWorkbooks
　　　Fnum = .FoundFiles.Count + 1
　 End With
　 NewFN = SvF & "\" & Format(Date, "yymmdd") & "_" & _
　 Left$(Dir(MyF), Len(Dir(MyF)) - 4) & "_" & Fnum & ".xls"
　 WB.Close True, NewFN: Set WB = Nothing
End Sub

てな感じでしょーか。
【41197】Re:ファイル名のオートナンバー
発言  ハチ  - 06/8/1(火) 17:54 -
引用なし
パスワード
   ▼もとあし さん：
ブックAからしかマクロで作成しないのなら、
どこかのセルに数値を保存しておけばナンバーリングできるのでは？

Option Explicit

Sub test()

Dim MyPath As String
Dim MyBook As String
Dim wb As Workbook

MyPath = Replace(ThisWorkbook.Path, "フォルダA", "フォルダB")
MyBook = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)

Set wb = Workbooks.Add

With ThisWorkbook.Worksheets(1)
　　Do Until Dir(MyPath & "\" & MyBook & "_" & .Range("A1").Value & ".xls") = ""
　　　　.Range("A1").Value = .Range("A1").Value + 1
　　Loop
　　wb.SaveAs Filename:=MyPath & "\" & MyBook & "_" & .Range("A1").Value & ".xls"
End With
wb.Close
Set wb = Nothing
End Sub
【41213】Re:ファイル名のオートナンバー
お礼  もとあし  - 06/8/2(水) 9:39 -
引用なし
パスワード
   Blueさん、Keinさん、ハチさん
お返事ありがとうございます♪

Blueさん：

>XXXXX_1.xls
>XXXXX_2.xls
>XXXXX_3.xls
>
>とあったら XXXXX_4.xls としたいということでしょうか？

はい。その通りです。

>そのとき、欠番は考慮するのでしょうか？

考慮していませんが、基本的には欠番は発生しないはずなのです。


Keinさん：

>With Application.FileSearch
>　　　.LookIn = SvF
>　　　.FileType = msoFileTypeExcelWorkbooks
>　　　Fnum = .FoundFiles.Count + 1
>　 End With

これはフォルダ内のファイル数をカウントしているのでしょうか？
フォルダAにはブックA以外にも
ブックAA、ブックAAAなる異なるデータのファイルも存在するので、
フォルダBにはブックB、ブックCとブックAからの抽出データファイル以外にも
ブックBB,ブックCCやブックBBB,ブックCCCなどと、フォルダAのブックA以外の
ブックからの抽出も保存されてきます。
そのブック毎の抽出データに番号を振りたいのです。


ハチさん：

マクロは多数の人が使う為、アドインにする予定となっており、
ブックA自体にはマクロは入れません。
ですが、ハチさんのおっしゃる、「どこかのセルに番号を入れておく」
というのが初心者の私には一番簡単なのかな？という気がしています。

>With ThisWorkbook.Worksheets(1)
>　　Do Until Dir(MyPath & "\" & MyBook & "_" & .Range("A1").Value & ".xls") = ""
>　　　　.Range("A1").Value = .Range("A1").Value + 1
>　　Loop

ですが、私にはなぜループをさせているのかが、分かりません。（ごめんなさい。）
フォルダ内に同一ファイルの重複がないようにしているのでしょうか？

皆様：
本当にありがとうございます。
「こんなこと、できないよ〜！」とがっくりきてましたが、
できそうな気がしてきて、嬉しくなってきました。
皆様からのヒントをもとに試行錯誤してみます。
またつまづいたら、書き込ませていただきますので、
そのときは教えてくださると助かります。
よろしくおねがいします (^o^)/
【41223】Re:ファイル名のオートナンバー
発言  ハチ  - 06/8/2(水) 12:50 -
引用なし
パスワード
   ▼もとあし さん

>マクロは多数の人が使う為、アドインにする予定となっており、
>ブックA自体にはマクロは入れません。
>ですが、ハチさんのおっしゃる、「どこかのセルに番号を入れておく」
>というのが初心者の私には一番簡単なのかな？という気がしています。

この内容だと全員がアクセスできるところにファイルを置く必要がありますので
逆に面倒だと思います。
他の方のレスを参考にされたほうが良いです。

>>With ThisWorkbook.Worksheets(1)
>>　　Do Until Dir(MyPath & "\" & MyBook & "_" & .Range("A1").Value & ".xls") = ""
>>　　　　.Range("A1").Value = .Range("A1").Value + 1
>>　　Loop
>
>ですが、私にはなぜループをさせているのかが、分かりません。（ごめんなさい。）
>フォルダ内に同一ファイルの重複がないようにしているのでしょうか？

ファイルを上書きせずに閉じるとか、マクロ以外でファイルが作られる、とか
イレギュラーもあるのかなぁ〜と思って、「おまじない」のつもりでLoopしてみました。
+1するだけで良いはずですので、もとあしさんの認識であっています＾＾
【41226】Re:ファイル名のオートナンバー
お礼  もとあし  - 06/8/2(水) 14:46 -
引用なし
パスワード
   ▼ハチ さん：

こんにちは。

>この内容だと全員がアクセスできるところにファイルを置く必要がありますので
>逆に面倒だと思います。
>他の方のレスを参考にされたほうが良いです。

記述しておりませんでしたが、そうなんです。
これは会社での使用で、ブックAやブックB,Cなどのデータは基本的に
すべてサーバに入っています。
アドインもサーバに入れてもらい、各PCは起動時に
サーバのアドインをコピーしてくるようになっています。
（聞いた話ですが・・・。）

>ファイルを上書きせずに閉じるとか、マクロ以外でファイルが作られる、とか
>イレギュラーもあるのかなぁ〜と思って、「おまじない」のつもりでLoopしてみました。
>+1するだけで良いはずですので、もとあしさんの認識であっています＾＾

↑ありがとうございます！！！
まさにマクロ以外でファイルが作られる可能性を懸念していました。
他の人が、私の予想を超えたことをしてくることは大いにありえるので、
ハチさんや他の方のレスを参考にながら慎重に作っていきたいと思っています。

ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7099 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free