Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : Excel 2010)
シートコピー、ファイル名指定保存の流れ
投稿日時: 18/06/14 09:27:30
投稿者: CBY

初めまして。VBA初心者をいつまでも抜け出せない者です。
マクロの実行により、マスターファイルから所定のシートをコピーして、ファイル名に日付を入れて保存したいと考えております。
A列下方に日付が追加されていくため、一番下のセルの日付を取得して、それをファイル名にしたいのです。
問題がありまして、この日付の形式がyyyy/m/dとなっているため、ファイル名にするにはyyyymmdd.xlsxにする必要があります。
さらに、同じ名前のファイルがない場合はそのまま保存。同じ名前のファイルがある場合は、置き換えて保存するようにしたいです。
アドバイスいただけないでしょうか。どうぞよろしくお願い致します。
 

回答
投稿日時: 18/06/14 10:48:35
投稿者: WinArrow
投稿者のウェブサイトに移動

日付をファイル名に取り込む例のコード
 
セルA10:日付形式
 
ファイル名:○○○20180615.xlsx
Dim ファイル名 As String
ファイル名 = "○○○" & Format(Range("A10").Value, "yyyymmdd") & ".xlsx"
 
同名のファイル存在チェック
 If Dir(ファイルパス) <> "" Then
  '重複
  Kill ファイルパス
End If

回答
投稿日時: 18/06/14 12:06:08
投稿者: mattuwan44

>問題がありまして、この日付の形式がyyyy/m/dとなっているため、
 → 一旦DateValue関数で日付に戻す。
>ファイル名にするにはyyyymmdd.xlsxにする必要があります。
 → 改めてFormat関数でyyyymmddという形式の文字列にする。
  
>さらに、同じ名前のファイルがない場合はそのまま保存。
>同じ名前のファイルがある場合は、置き換えて保存するようにしたいです。

SaveAsメソッドで新たに保存したときに、すでにファイルが存在した場合、
上書きの確認のダイアログボックスが出てきますが、
このダイアログボックスが表示されることを無効化することができます。
↓参照URL>>
 https://www.relief.jp/docs/excel-vba-save-same-file-name-force.html

投稿日時: 18/06/14 13:11:21
投稿者: CBY

コメントありがとうございます!
下記、書いてみたのですが、どうも進まず、つまずいております。
 
'@シートをコピーして新しいブック
  Dim bk As Workbook
    Dim d As Date
 
    With Sheets("Sheet1").Copy
         
'A名前を付ける。最終行の日付を取得して、日付の方を変えて、ファイル名にする
    Set bk = Workbooks.Add
    bk.SaveAs "パス\フォルダ名" & Format(d, "yyyy/m/d", "yyyymmd") & ".xlsx"
    .Range("A1:Y" & .Range("A1048576").End(xlUp).Row).Copy: Workbook (d, "yyyy/m/d", "yyyymmdd") = ".xlsx")
 
同じファイル名云々は次のステップにしたいと思っています。

回答
投稿日時: 18/06/14 18:14:51
投稿者: WinArrow
投稿者のウェブサイトに移動

CBY さんの引用:
コメントありがとうございます!
下記、書いてみたのですが、どうも進まず、つまずいております。
 
'@シートをコピーして新しいブック
  Dim bk As Workbook
    Dim d As Date
 
    With Sheets("Sheet1").Copy
         
'A名前を付ける。最終行の日付を取得して、日付の方を変えて、ファイル名にする
    Set bk = Workbooks.Add
    bk.SaveAs "パス\フォルダ名" & Format(d, "yyyy/m/d", "yyyymmd") & ".xlsx"
    .Range("A1:Y" & .Range("A1048576").End(xlUp).Row).Copy: Workbook (d, "yyyy/m/d", "yyyymmdd") = ".xlsx")
 
同じファイル名云々は次のステップにしたいと思っています。

 
 
論理的にめちゃくちゃです。
シートをコピーした時点で、新しいブックが生成されていすので
Workbooks.Add
は不要。
 
それより
変数「d」で日付をセットしていなのに、Format関数はNG
 
新提案
  Dim bk As Workbook
    Dim d As Date
    Dim FileName As string
 
    Sheets("Sheet1").Copy
    Set bk = Activeworbook
    With bk
        With .Sheets(1)
            d = .Range("A" & .ROws.Count).End(xlup).Value
        End With
        FileName = "パス\フォルダ名\" & Format(d, "yyyymmd") & ".xlsx"
        If Dir(FileName) <> "" Then
            Kill FileName
        End If
        .SaveAs FileName
    End With
 

回答
投稿日時: 18/06/14 20:59:44
投稿者: もこな2

横からですが、拝見しててちょっと気になったのですが
"yyyymmd" でなくて "yyyymmdd"では?
(ダメじゃ無いんでしょうけど単純な漏れのような気が・・・)
 
また、既に WinArrowさんが、新提案されてますけど、
(1)個人的にActive○○って記述を避けたい
(2)探し出してkillするくらいなら、mattuwan44さんの言うとおり強制上書きすればいい
とおもったので、ちょこっと改変してみました。参考になれば・・・
(これはこれで、ほんとにシート名が"Sheet1"だとかっこわるいことになりますが・・・)

Sub Sample()  
    Dim d As Date

    With Workbooks.Add(xlWBATWorksheet)
        ThisWorkbook.Sheets(1).Copy Before:=.Sheets(1)
        
        With .Sheets(1)
            d = .Range("A" & .Rows.Count).End(xlUp).Value
        End With
        
        Application.DisplayAlerts = False
        '新規ブックを生成するときに作成されるシートを削除
        .Worksheets(2).Delete
        .SaveAs FileName:="パス\フォルダ名\" & Format(d, "yyyymmdd")
        .Close  '保存したらさっさと閉じるようにしてみる。
        Application.DisplayAlerts = False

    End With
End Sub

投稿日時: 18/06/15 14:57:26
投稿者: CBY

お助けいただきまして、ありがとうございました。
綺麗に流れ、きちんと保存されました。
大変助かりました。重ね重ねお礼申し上げます。