[[20210608102938]] 『VBA 取得ファイル名の並び替え』(にゃーべ) ページの最後に飛ぶ

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

 

『VBA 取得ファイル名の並び替え』(にゃーべ)

よろしくお願いします。

他の型の情報を参考に下記コードを作りファイル名を取得して並び替えをしているのですが、
どうしても並び替えが上手く行きません。

Sub ファイル一覧の取得()

Dim buf As String
Dim cnt As Long

    Dim LastRow As Long
    LastRow = Cells(Rows.Count, 22).End(xlUp).Row

    cnt = LastRow

Const Path As String = "W:\●●●\■■■\▲▲▲\"
buf = Dir(Path & "*.xlsm")
Do While buf <> ""
cnt = cnt + 1
Range("V" & cnt) = buf
buf = Dir()
Loop

    Call Range("V7:V106").Sort( _
    Key1:=Range("V7"), _
    Order1:=xlAscending)

End Sub

上記コードを実行後、TEST_21-1,2,3,…,9までは順番通りに並ぶのですが
10以降を取得すると、TEST_21-1,10,11,12,2,3という風に並んでしまいます。
参照先のフォルダではTEST_21-1,2,3,…,9,10,11,12と並んでおり、同じ順番に並ぶようにしたいです。

お忙しいところ恐縮ですが、アドバイスをお願いします。

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


 直接の回答ではありません。

 作成日時か更新日時も取得して、それをキーにしてソートするとか。

 ※ファイル名でソートしたい場合は、月とか日の部分も二けたにするのが
 いいと思います。
(OK) 2021/06/08(火) 10:56

 余談です。

 1月11日→111
 11月1日→111

 区別つきません。

 1月11日→0111
 11月1日→1101

 区別つきます。

(OK) 2021/06/08(火) 11:01


 > Range("V7:V106")

 せっかくLatRowで最終行を取得してるのに活用されてませんね。
(OK) 2021/06/08(火) 11:21

 LastRowではなくcntの方でした。
(OK) 2021/06/08(火) 11:22

W列に数値部分を取り出して、それをキーにしてソートするのがよろしいかと思います。

数値部分の取出し方はいろいろありますが、一例です。

 Range("W7") = Abs(Left(Right(Range("V7"), 7), 2))

(ひまつぶし) 2021/06/08(火) 14:18


OK さん

アドバイスありがとうございました。
余談で回答頂いた区別の方法にファイル名を変更したところ並び替えたい順番に並ぶようになりました。

 1→001、2→002、3→003 …

ですが、別の投稿でもアドバイスを頂いていた下記VBAでエラーがでるようになってしまいました。
エラーの内容は今まで「cnt2」の数値が1,2,3…と繰り上がって処理ができていたのですが、ファイル名を3桁に対応できていないようです。
3桁に対応させるためにはどうすればよいでしょうか。
色々調べてみてRight関数ができるにみたいだったのですが、上手く行きませんでした。

Sub test()
Dim cnt As Long
Dim cnt2 As Long
Dim LastRow As Long

LastRow = Cells(Rows.Count, 4).End(xlUp).Row

cnt = 1 + LastRow
cnt2 = cnt - 6
Do While Range("B" & cnt) <> ""

 If Range("B" & cnt) = Range("C" & cnt) Then
    With Range("D" & cnt)
    .Formula = "='D:\●●●\▲▲▲\◆◆◆\[TEST_21-" & cnt2 & ".xlsm]TEST'!AB5"
    .Value = .Value
    End With
    With Range("E" & cnt)
    .Formula = "='D:\●●●\▲▲▲\◆◆◆\[TEST_21-" & cnt2 & ".xlsm]TEST'!M7"
    .Value = .Value
    End With
  ・
  ・
  ・
cnt = cnt + 1
cnt2 = cnt2 + 1
End If
Loop
End Sub

>せっかくLatRowで最終行を取得してるのに活用されてませんね。
> LastRowではなくcntの方でした。

これってどういう意味なのでしょうか。

よろしくお願いします。
(にゃーべ) 2021/06/08(火) 14:26


 .Formula = "='D:\●●●\▲▲▲\◆◆◆\[TEST_21-" & cnt2 & ".xlsm]TEST'!AB5"
 ここの部分を
 .Formula = "='D:\●●●\▲▲▲\◆◆◆\[TEST_21-" & Format(cnt2, "000") & ".xlsm]TEST'!AB5"
 に変えてください
(シオラ) 2021/06/08(火) 14:45

シオラさん、ひまつぶしさん

アドバイスありがとうございました。
シオラさんのアドバイス頂いた内容に変更したら、思い通りのことができましたので、そちらを使わせてもらいました。

また、最初に投稿させて頂いたファイル取得について、重複ファイル名は取得しないとしたく色々調べてみました。
DictionaryやCollectionなどを使うとあり、自分なりに追加したりしてみたのですが、どうしてもできませんでした。
こちらについてもアドバイスを頂けますでしょうか。

よろしくお願いします。
(にゃーべ) 2021/06/09(水) 10:24


問い合わせする質問内容に間違いがあったので、訂正させて頂きます。

例えば、1回目の処理で取得したファイル名はV列に貼り付けられますが、
その取得したファイル名はV列にそのまま残っており、2回目の処理の際に
V列に貼り付けられたファイル名と同じファイルがあった場合、
そのファイル名は取得しないという風な動作できればと考えています。

よろしくお願いします。
(にゃーべ) 2021/06/09(水) 14:41


 Sub ファイル一覧の取得()
    Dim buf As String
    Dim cnt As Long
    Dim LastRow As Long
        LastRow = Cells(Rows.Count, 22).End(xlUp).Row
        cnt = LastRow
    Const Path As String = "D:\●●●\▲▲▲\◆◆"

    buf = Dir(Path & "*.xlsm")

    Do While buf <> ""
       If InStr(buf, "TEST_21-") <> 0 Then
          buf = Left(buf, InStr(buf, "-")) & _
                 Format(Mid(buf, InStr(buf, "-") + 1, InStr(buf, ".") - InStr(buf, "-")), "000") & _
                  Mid(buf, InStr(buf, "."), Len(buf))
       End If
       If WorksheetFunction.CountIf(Range("V2:V" & cnt), buf) = 0 Then
          cnt = cnt + 1
          Range("V" & cnt) = buf
       End If
       buf = Dir()
    Loop

    Call Range("V7:V"& cnt).Sort( _
               Key1:=Range("V7"), _
               Order1:=xlAscending)

 End Sub
 こんな感じですか?
(シオラ) 2021/06/09(水) 15:20

シオラさん

おはようございます。
ご提示いただいたコードを実行したところ、希望していた内容の動作ができました。
お忙しいところ対応して頂きありがとうございました。
(にゃーべ) 2021/06/10(木) 08:10


コメント返信:

[ 一覧(最新更新順) ]


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