[[20211121223428]] 『フォルダ内のいちばん新しいファイルを開く』(はなれ) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『フォルダ内のいちばん新しいファイルを開く』(はなれ)

マクロ使用で
Aフォルダ内に毎週末に作成した、
年月週のエクセルファイルがあり、
いちばん新しいファイルを開くコードを
教えてください。

ファイル名は、
2021-11-04.xlsx
2021-11-03.xlsx



のようになっております。
よろしくお願いします。

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


https://officedic.com/excel-vba-newdate-file/
を読んでみてください。

(γ) 2021/11/21(日) 23:23


名前で判断する例

 Sub test()
    Dim fn As String
    Dim p As String
    Dim cmd As String

    fn = "????-??-??.xlsx"
    p = "D:\Aフォルダ\"
    cmd = "cmd /c dir """ & p & fn & """ /b/o-n"
    Workbooks.Open p & Split(CreateObject("wscript.shell").exec(cmd).stdout.readall, vbCrLf)(0)

 End Sub

(マナ) 2021/11/21(日) 23:56


名前で判断する例を使用したら、
問題なくできました!
ありがとうございます!
(はなれ) 2021/11/22(月) 05:47

 参照サイトの内容を少し変えました。

 Sub test()
     Dim pathName As String
     Dim fileDate As Date
     Dim latestDate As Date
     Dim fileName As String
     Dim maxFileName As String

     pathName = "D:\MyDocuments\202111\"     '■フォルダ名を修正ください。
     fileName = Dir(pathName & "????-??-??.xlsx")
     Do While fileName <> ""
         fileDate = DateValue(Left(fileName, 10))
         If fileDate > latestDate Then
             latestDate = fileDate
             maxFileName = fileName
         End If
         fileName = Dir()
     Loop
     Workbooks.Open pathName & maxFileName    '最終的に最新日時のファイルを開く
 End Sub

 もらった回答にもし不明点があれば質問されたほうがいいですよ。
 もし同じようなことが出てきたときに、自身で対応できるように。
(γ) 2021/11/22(月) 07:17

ありがとうございます!
今回の作業がファイル名の方が都合が良いと思い、
名前で作業する例を使用させてもらいました。

(はなれ) 2021/11/24(水) 19:10


たびたび、すいません。

この開いたファイルから、A列のどこかに書かれている
○○○○(仮)と書かれた文字列を検索し、
その一行上セルを基準に、右20下3までのセルをコピーし、
開くために使ったシートのB10に貼り付けをしたいです。

お時間があったら教えてください。

(はなれ) 2021/11/24(水) 19:20


>この開いたファイルから、A列のどこかに書かれている

 シート名は?

>その一行上セルを基準に、右20下3までのセルをコピーし

 もし、A11が、○○○○(仮)であったら
 コピー範囲は、どこになりますか。

>開くために使ったシートのB10に貼り付けをしたいです。

 シート名は?

 ^^^^^
これ↓が、構文です。
 コピー範囲.Copy 貼り付け先

 コピー範囲と貼り付け先ともに、
 ブックだけでなく、シートも指定することが重要です。

(マナ) 2021/11/24(水) 20:17


編集がかぶりましたがそのまま。

■1
>開いたファイルから、A列のどこか
「A列」はシートに属するので、まずはそのA列は【開いたブック】の"どのシート"のことなのか特定しましょう。

■2
>文字列を検索し
Match関数を使うとか、(ループ処理で)1行目から順番に見ていくとか、Findメソッドで調べるとかいろいろあります。
とりあえず、ネット検索してみてはどうでしょうか?

■3
>その一行上セルを基準に、右20下3までのセル
Offset、Resizeについて調べてみるとよいとおもいます。

■4
>セルをコピーし
【マクロの記録】で必要な命令を調べることができます。

■5
>開くために使ったシート
要はブックを開く前のActiveSheetですかね。
それなら、ブックを開く前に覚えておきましょう。

(もこな2) 2021/11/24(水) 20:19


返信ありがとうございます!

シート名を指定しなきゃ動かないのですね。
開いたファイルに名前をセットして満足してました。
シート名を入れてませんでした。
ファイル名は職場名&ファイル名だと思いますが、
シートの作成者が入力間違えてたら、使えませんか?
シートは、ブックにひとつだけです。

A11の場合、A10:T13です。

(はなれ) 2021/11/24(水) 21:11


>シートは、ブックにひとつだけです。
それなら1番目のシートということになりますから↓のようにすればよいですね。
 [開いたブック].Worksheet(1)〜〜〜

(もこな2) 2021/11/25(木) 00:31


すみません、家で理解しようと試みてるんですが
わかりません。

Dim myrange As Range
Set myrange = Worksheets(1).Range("A:A").Find("○○○○")
If myrange Is Nothing Then
MsgBox "○○○○はありませんでした。"

ここまではわかるのですが、
○○○○があった場合、
この○○○○のセルの一行上のセルを
指定する方法が分かりません。

myrange.Offset(-1,0).Value = "××"
で、上のセルに××と入力はできることはわかったのですが。
文字を入力したいわけではなく、セルを指定したいです。
申し訳ないですが、教えてください。

(はなれ) 2021/11/26(金) 11:38


 myrange.Offset(-1,0)
↑
これがセルです。

 myrange.Offset(-1,0).Select
これで選択できます。

 Set myRange = myrange.Offset(-1,0)
これでmyRangeのセルを変更することができます。
(きまぐれおじさん) 2021/11/26(金) 12:47

ちんたら書き溜めている間に回答が付いてますが、書いてしまったので投稿しておきます。

■6
>文字を入力したいわけではなく、セルを指定したいです。
分からない箇所がピンと来ませんが、とりあえずFindメソッドで探す方法で行くということですね。

Findメソッドは【セル】を探す命令ですが、使うにあたりいくつか気を付けたほうがよい点がありますが、中でも【引数を省略した場合、前回値が引き継がれる】ということろは理解されておいたほうがよいでしょう。

 【参考】
https://www.moug.net/tech/exvba/0150111.html

したがって↓を

 [検索対象のセル範囲].Find("○○○○")

↓のようにされたほうが良いと思います。

 [検索対象のセル範囲].Find(What:="○○○○", LookIn:=xlValues, LookAt:=xlWhole)

■7
さて、上記で述べたようにFindメソッドは【セル】を探します。
また、見つからなかった場合は【Nothing】という特殊なものを返します。

すなわち、例えば【A11】セルで見つかったのであれば↓の場合

 Set myrange = Worksheets(1).Range("A:A").Find("○○○○")

 見つかった場合・・・・・「myrange」にWorksheets(1).Range("A11") が格納される
 見つからなかった場合・・「myrange」にNothingが格納される

ということになります。
なので、Findメソッド実行後に「myrange」を調べて【Nothingじゃなかったら】見つかっているし、「myrange」そのものが、当該セルを示していることになります。

■8
Offsetは調べて理解できたのでしょうか?
たとえば↓は,【A11】から-1行、±0列ずれるということを示しているので、【A10】という意味になります。

 Range("A11").Offset(-1,0)

今回は↓ですから、このOffsetが使えますね
>その一行上セル

■9
Resizeのほうは調べてみたのでしょうか?
例えば↓は、A10セルをA10セルを基準にして、3行・20列に拡張(縮小)したセル範囲を示しています。
 Range("A10").Resize(3, 20)

今回は↓ですから、このResizeを使えばよさそうですね。
>上セルを基準に、右20下3までのセル

■10
ということを踏まえて組み立てると↓のような感じになるとおもいます。

    Sub 研究用()
        Dim 出力SH As Worksheet
        Dim WB As Workbook
        Dim myrange As Range

        Set 出力SH = ActiveSheet

        '▼ブックを開いて「WB」にセット
        Set WB = Workbooks.Open("〜〜〜〜〜〜")

        Stop 'ブレークポイントの代わり

        '▼Findメソッドで探す
        Set myrange = WB.Worksheets(1).Range("A:A").Find(What:="○○○○", LookIn:=xlValues, LookAt:=xlWhole)

        '▼見つかったかどうかで処理分岐
        If myrange Is Nothing Then
            MsgBox "○○○○はありませんでした。"
        Else
            '▼コピペを実行
            myrange.Offset(-1, 0).Resize(3, 20).Copy 出力SH.Range("B10")
        End If
    End Sub

これで目的は達せられるのではないでしょうか?

(もこな2) 2021/11/26(金) 13:55


ありがとうございます。
Offset,Resizeの意味はわかりました!
自分の使い方がおかしいので、上手く出来ていないのだと
おもってます。
また、何度もすいません。

Sub 研究用()

        Dim 出力SH As Worksheet
        Dim WB As Workbook
        Dim myrange As Range
        Set 出力SH = ActiveSheet

        Set WB = Workbooks.Open("〜〜〜〜〜〜")
        Stop

        Set myrange = WB.Worksheets(1).Range("A:A").Find(What:="○○○○", LookIn:=xlValues, LookAt:=xlWhole)

        If myrange Is Nothing Then
            MsgBox "○○○○はありませんでした。"
        Else
          myrange.Offset(-1, 0).Resize(3, 20).Copy 出力SH.Range("B10")
        End If

この後に、

Set myrange = WB.Worksheets(1).Range("A:A").Find(What:="△△△△", LookIn:=xlValues, LookAt:=xlWhole)

      If myrange Is Nothing Then
            MsgBox "△△△△はありませんでした。"
        Else
     myrange.Offset(-1, 0).Resize(3, 20).Copy 出力SH.Range("B14")
        End If    

End Sub

としたら、正常に動きますでしょうか?

自分のやり方が悪いせいか、
○○○○はできたのですが、
△△△△が出来なくて。
(はなれ) 2021/11/27(土) 00:36


■11
>自分のやり方が悪いせいか、
>○○○○はできたのですが、△△△△が出来なくて。

実際のコードをご提示ください。(状況だけ説明されても判断できません)
また、できないとはどのような状態を言っているのか説明してください。
(エラーが出るなら、その箇所・エラー番号・エラーメッセージをエラーにならないが、想定通りの結果にならないなら、××になるはずが○○になってしまう等)

(もこな2) 2021/11/27(土) 01:44


ありがとうございました。
自宅のパソコンで全て組み合わせました。
実作業は月曜日になります。
これで、たぶん大丈夫だと思いますが、
おかしなところがありましたら、お願いします。

Sub 研究用()
Dim 出力SH As Worksheet
Dim WB As Workbook
Dim myrange1 As Range
Dim myrange2 As Range

Dim pathName As String
Dim fileDate As Date
Dim latestDate As Date
Dim fileName As String
Dim maxFileName As String

Set 出力SH = ActiveSheet
pathName = "C:\Users\Desktop\フォルダー\"
fileName = Dir(pathName & "????-??-??.xlsx")
Do While fileName <> ""
fileDate = DateValue(Left(fileName, 10))
If fileDate > latestDate Then
latestDate = fileDate
maxFileName = fileName
End If

fileName = Dir()

Loop

Set WB = Workbooks.Open(pathName & maxFileName)

Set myrange1 = WB.Worksheets(1).Range("A:A").Find(What:="○○○○", LookIn:=xlValues, LookAt:=xlWhole)

If myrange1 Is Nothing Then

MsgBox "○○○○はありませんでした。"

 Else

myrange1.Offset(-1, 0).Resize(3, 169).Copy 出力SH.Range("B10")

 End If

Set myrange2 = WB.Worksheets(1).Range("A:A").Find(What:="××××", LookIn:=xlValues, LookAt:=xlWhole)

If myrange2 Is Nothing Then

 MsgBox "××××はありませんでした。"
Else

myrange2.Offset(-1, 0).Resize(3, 169).Copy 出力SH.Range("K10")

 End If

WB.Worksheets(1).Range("A1").Copy 出力SH.Range("A1")
WB.Close SAVECHANGES:=False

End Sub

あと、この出力SHを開いたものと同じ名前で
保存したいです。
保存フォルダは別の場所です。
数箇所編集を行い、上書き保存するので、
ブックは閉じません。

(はなれ) 2021/11/27(土) 13:16


■12
コードは分かりました。

↓も教えてください
>また、できないとはどのような状態を言っているのか説明してください。
>(エラーが出るなら、その箇所・エラー番号・エラーメッセージをエラーにならないが、想定通りの結果にならないなら、××になるはずが○○になってしまう等)

あと、こだわりがなければインデントを付けたほうがよいですよ。
(見やすくなってご自身のデバッグ作業の効率アップに寄与するとおもいますので。)

(もこな2) 2021/11/27(土) 14:05


■13
提示のコードをインデントをつけつつ、少し改造してみました。
    Sub 研究用2()
        Stop 'ブレークポイントの代わり        
        Const フォルダパス As String = "C:\Users\Desktop\フォルダー\"

        '▼ファイル名から日付を取り出して、一番最近の【日付】を調べる
        Dim fileName As String
        Dim MyDate As Date
        fileName = Dir(フォルダパス & "????-??-??.xlsx")
        Do While fileName <> ""
            MyDate = WorksheetFunction.Max(DateValue(Left(fileName, 10)), MyDate)
            fileName = Dir()
        Loop

        '▼ブックを開く前にアクティブシートを出力先として覚える
        Dim 出力SH As Worksheet
        Set 出力SH = ActiveSheet

        '▼実際にブックを開いて操作する
        Dim 探したセル As Range
        With Workbooks.Open(フォルダパス & Format(MyDate, "yyyy-mm-dd") & ".xlsx")
            '---------------------------------------------------------------------------------------------------------------------------
            Set 探したセル = .Worksheets(1).Range("A:A").Find(What:="○○○○", LookIn:=xlValues, LookAt:=xlWhole)
            If 探したセル Is Nothing Then
                MsgBox "○○○○はありませんでした。"
            Else
                探したセル.Offset(-1).Resize(3, 169).Copy 出力SH.Range("B10")
            End If
            '---------------------------------------------------------------------------------------------------------------------------
            Set 探したセル = .Worksheets(1).Range("A:A").Find(What:="××××", LookIn:=xlValues, LookAt:=xlWhole)
            If 探したセル Is Nothing Then
                MsgBox "××××はありませんでした。"
            Else
                探したセル.Offset(-1).Resize(3, 169).Copy 出力SH.Range("K10")
            End If
            '---------------------------------------------------------------------------------------------------------------------------
            .Close False
        End With
    End Sub

※こちらで↑をテスト実行したところ、特に問題はでませんでした。

■14
>あと、この出力SHを開いたものと同じ名前で
>保存したいです。
>保存フォルダは別の場所です。
>数箇所編集を行い、上書き保存するので、
>ブックは閉じません。

マクロの記録で必要な命令を調べることができると思いますのでトライしてみてはどうですか?
なお、「保存フォルダは別の場所です。」であれば、上書き保存ではなく、同名ファイルがあっても構わず保存ですね。(こちらは、マクロの記録では得られないので一工夫必要です)

(もこな2) 2021/11/27(土) 17:01


返信遅くなりました。

枠外のセルにファイル名にしたい文字を関数で
表示させ、
保存フォルダパスとファイル名で保存することが出来ました。

ありがとうございました!
(はなれ) 2021/12/06(月) 13:40


■15
>保存フォルダパスとファイル名で保存することが出来ました。
おそらく、SaveAsメソッドを使ったと思いますが、↓のように【SaveCopyAsメソッド】を使うという手もあります。(こちらはマクロの記録では得られません)
    Sub 研究用()
        Dim WB As Workbook
        Set WB = ThisWorkbook

        Stop 'ブレークポイントの代わり

        WB.SaveCopyAs "C:\別の場所\" & WB.Name
    End Sub

■16
>自分のやり方が悪いせいか、
>○○○○はできたのですが、△△△△が出来なくて。

結局↑は解決したのですか?
↓のお返事がありませんが・・・・

 【再掲】
 >また、できないとはどのような状態を言っているのか説明してください。
 >(エラーが出るなら、その箇所・エラー番号・エラーメッセージをエラーにならないが、
   想定通りの結果にならないなら、××になるはずが○○になってしまう等)

(もこな2 ) 2021/12/07(火) 07:36


すいません!
その時にエラーとなっていた内容は、
いろいろ試して入力したら、正常に動きました。

エラーの内容も覚えていません。
申し訳ありません。
ありがとうございました!
(はなれ) 2021/12/07(火) 13:57


コメント返信:

[ 一覧(最新更新順) ]


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