VBAでしょうか！？

質問

フォルダの中には日付（xxx6_19）がファイル名の複数のCSVファイルがあります。
エクセルでメニュー画面を作成しワンクリックで当フォルダ内の一番最近のファイルを開き、尚且つ１つの項目を並び替えて上位５位までを表示させる方法を教えて下さい！

回答No.6

nishi6 · ベストアンサー

>更新日時でソートし昨日・今日の日付分の行を薄く塗りつぶす！

cvsファイルを呼び出すために使っているブックの標準モジュールに貼り付けます。

少し不明点が・・・。ソートは逆順にしています。（昇順はxlAscendingにします）
昨日、今日をどうつかむか・・・。今はパソコンの機械日付<Now()>を今日にしています。
薄く塗りつぶす・・・。カラーインデックス15等を適当に使っています。
csvデータの最初は表題と考えています。（ソートに関係します）
うまくいけばいいですね。では。

Public Sub CSVdataSort()
Const ksYMD = "AM" '更新日時の列名
Dim w As Workbook 'ブック
Dim CsvShtName As String 'csvファイルを読み込んだブック
Dim CsvFileCot As Integer 'csvファイルの個数
For Each w In Application.Workbooks
If Right(w.Name, 3) = "csv" Then
CsvShtName = w.Name: CsvFileCot = CsvFileCot + 1
End If
Next
If Len(CsvShtName) = 0 Then 'ファイルなしの場合
MsgBox "ＣＶＳファイルがありません": Exit Sub
End If
If CsvFileCot > 1 Then
MsgBox "ＣＶＳファイルが複数あります。中断します": Exit Sub
End If
'元のシートから読み込んだＣＶＳファイルを操作
Windows(CsvShtName).Activate 'アクティブにする
Cells.Select 'シートを選択
Cells.EntireColumn.AutoFit '列幅を自動調整する
ActiveSheet.UsedRange.Select 'データ部分を選択
'更新日時で降順にソート
Dim sKey As Range 'ソートキー
Set sKey = Range(ksYMD & "2")
Selection.Sort Key1:=sKey, Order1:=xlDescending, Header:=xlGuess
'今日、昨日の行に色を付ける
Dim rg As Range '更新日時データ範囲
Dim rgRow As Long '色を付ける行
Dim rowNum As Integer 'データ範囲の行数
Dim colNum As Integer 'データ範囲の列数
With ActiveSheet
rowNum = .UsedRange.Rows.Count
colNum = .UsedRange.Columns.Count
For Each rg In .Range(ksYMD & "2:" & ksYMD & rowNum)
rgRow = rg.Row
With Range(Cells(rgRow, 1), Cells(rgRow, colNum))
If rg = Int(Now()) Then '今日
.Interior.ColorIndex = 15 'カラーインデックス15
End If
If rg = Int(Now() - 1) Then '昨日
.Interior.ColorIndex = 34 'カラーインデックス34(36も薄い色？)
End If
End With
Next
Range("A1").Select
End With
End Sub

お礼

パソコン復旧作業の為、少し空いてしまいました。その間に回答ありがとうございます。アドバイス通り作業すると順調にいきました！そこでしめとしてB、C、D列を非表示にしたいのですが・・・「もっと早言えよ！」と言われそうですが・・・それと基本的な事ですが現在メニュー画面としてボタンを２つ用意し，１つ目は検索用として特定フォルダから最新ファイルを選択、もう１つはそれを更新日時でソートし尚且つ今日昨日の行に色を付けるように出来ました。本当にありがとうございます。作業上、便宜を図るために１つ目のボタンをクリックし、最新ファイルを検索後”その表示したシート上に２つ目のボタン作成し実行、若しくは最新ファイル選択後、一旦メニュー画面に戻り２つ目のボタンをクリック！”ってな具合にしたいのですが。どちらかと言えば後者の方を・・・
意味分かります！？ようは処理させたところにボタンがあり連続して作業が出来るようにしたいのですが。もちろんワンクリックすべての処理が出来ればそれに越したことはありません。何も分からずして毎回ずうずうしくてすみません・・・非表示の分とあわせてよろしくお願いします。
～～～現在パソコンが不安定な状態でいつフリーズするかヒヤヒヤしながら作業している毎日です。

回答No.5

nishi6

ANo#2に下記の４行を追加し実行結果のイミディエイトウインドウの内容を補足して下さい。最初の2、3件と最後の2、3件を見たいので、途中はカットしてもらってかまいません。それに、ダイアログのメッセージは私の作ったダイアログの文言でしょうか。

myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり
myFileName = "*.csv" '月日は4桁

Debug.Print myDir & myFileName & ":初期値" '*** 追加 ***
Dummy = Dir(myDir & myFileName)
Debug.Print myDir & Dummy & ":検索1回目" '*** 追加 ***
While Len(Dummy) > 0
YMD8new = ymdHenkan(Dummy)
If YMD8old < YMD8new Then
mySchFileName = Dummy
YMD8old = YMD8new
End If

Dummy = Dir
Debug.Print myDir & Dummy & ":継続検索" '*** 追加 ***
Wend
Debug.Print myDir & mySchFileName & ":検索結果" '*** 追加 ***
If mySchFileName <> "" Then

お礼

アドバイス通りコード追加して実行したところ
イミディエイトウインドウに検索・検索結果が順に表示され・・
検索結果をよくみるとちゃんと指定したフォルダから
最新日時のファイルを検索していました。
なにかよくわからないまま解決したような感じで・・
本当にありがとうございます。
あつかましいですがその開いたファイルを次の処理として
更新日時でソートし昨日・今日の日付分の行を薄く塗りつぶす！
このようにしたいのですが、マクロをどこに書くのか分からず、
また書く場所によって違いますよね！？
ようは最新ファイルを開いたあとその処理をしたいのですが？

ファイルの内容は

A列　B列　C列・・・　AL列　　　AM列
名前　住所　TEL　　登録日時　　更新日時

といった具合に配列してあります。

回答No.4

nishi6

拡張子(.csv)があるようなのでANO.#2を使います。
確認ですが、ご自分のフォルダを指定してください。\あり」 の「ご自分のフォルダ」はcsvファイルがあるフォルダです。「\あり」は「C:\xxxxx\xxxxx\」のように登録して最後に「\」が必要ということです。

また、下記の様にしてみて下さい。実行した後、イミディエイトウインドウ（もしくはデバッグウインドウ）を開いて、開こうとしたファイル名を確かめてください。ドライブ名+フォルダ名+ファイル名になっていて、各々は\でつながっているでしょうか。何も表示されなかったら、拡張子が.csvではないか、指定したフォルダに.csvファイルがないような気がします。
最後のメセージを修正したのは、マクロからのメッセージかどうか確かめたいからです。確認をお願いします。また、マクロの先頭に「Option Explicit」が無ければ入力してください。スペルミスがあるかもしれません。マクロはコピーして貼り付けられました？
それと、Excelのバージョンは？

途中から・・・
myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり
myFileName = "*.csv" '月日は4桁
　　　：
　　　：
If mySchFileName <> "" Then
Debug.Print myDir & mySchFileName　 '*** 追加します ***
Workbooks.Open Filename:=myDir & mySchFileName
Else
MsgBox "ファイルがありません（マクロのメセージ）" '*** 修正します ***
End If
End Sub

お礼

本当に事細かくアドバイスありがとうございます。
しかし、結論からいいますとダメでした。
アドバイス通り試みイミデイエイトウインドウで確認したところ、
なにも表示されていませんでした。
拡張子も表示していますし、ファイルのあるフォルダ名も入力ミスはないと思います。（ファイルのプロパティから{場所}をコピーしてあてはめています）
バージョンはExcel2000です。
尚、マクロはコピーできています。
コード等全くわからない為、応用が利かないのが現実です。
もう一度ファイル名を確認します「101010-keymans-2001-6-21.csv」
といった具合です。
度重なる内容不十分で大変申し訳ありません。

回答No.3

nishi6

修正する箇所は１箇所です。フォルダをセットし、最後に\があればいいです。

多分、そうされてのことだと思い、なぜ動かないか考えてみました。
私は、csvファイルということで、ファイルの拡張子がcsvだと決めて作っています。#1の「お礼」にあるファイル名から推測すると拡張子が無いような気がします・・・下記に拡張子が無いcsvファイルを読めるようにしてみました。拡張子が無ければこちらを試してください。

Sub CommandButton1_Click()
Dim myDir As String 'ファイルガあるドライブとフォルダ
Dim myFileName As String '探すファイル名(ワイルドカード)
Dim Dummy As String '作業用ファイル名と見つかったファイル名
Dim mySchFileName As String '作業用ファイル名と見つかったファイル名
Dim YMD8old, YMD8new As Long 'ファイルがもつ月日

myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり
myFileName = "*.*"

Dummy = Dir(myDir & myFileName)
While Len(Dummy) > 0
If InStr(Dummy, ".") = 0 Then
YMD8new = ymdHenkan(Dummy)
If YMD8old < YMD8new Then
mySchFileName = Dummy
YMD8old = YMD8new
End If
End If

Dummy = Dir
Wend
If mySchFileName <> "" Then
Workbooks.OpenText Filename:=myDir & mySchFileName, DataType:=xlDelimited
Else
MsgBox "ファイルがありません"
End If
End Sub

'ファイル名の年月日を8桁にする
Function ymdHenkan(myFileName As String)
Dim wkFLname As String 'ワーク
Dim L As Integer 'カウンタ
Dim yy, mm, dd As String '年、月、日
Dim pot(4) As Integer '「-」の位置
Dim potIdx As Integer '「-」の位置の順

wkFLname = myFileName & "-"
For L = Len(wkFLname) To 1 Step -1
If Mid(wkFLname, L, 1) = "-" Then
potIdx = potIdx + 1
pot(potIdx) = L
End If
If potIdx = 4 Then Exit For
Next
yy = Mid(wkFLname, pot(4) + 1, pot(3) - 1 - pot(4))
mm = Right("0" & Mid(wkFLname, pot(3) + 1, pot(2) - 1 - pot(3)), 2)
dd = Right("0" & Mid(wkFLname, pot(2) + 1, pot(1) - 1 - pot(2)), 2)
Debug.Print ymdHenkan
ymdHenkan = Val(yy & mm & dd)
End Function

お礼

事細かく回答頂き本当にありがとうございます。
しかし解決されませんでした・・・前回と同じように「ファイルが見つかりません」と表示されます。おっしゃるように拡張子は表示していませんでした。で表示させて試みてもダメでした・

回答No.2

nishi6

VBEのシート(Sheet1等)のコードウインドウに貼り付けてマクロを実行してください。
年4桁、月・日(1桁か2桁)の一番最近のファイルを開きます。 「myDir」はご自分のドライブ＋フォルダに変更してください。
Excel2000だとSplit、InStrRev関数等を使って書けますが、Excel95、97でも動くようにしてあります。

Sub CommandButton1_Click()
Dim myDir As String 'ファイルガあるドライブとフォルダ
Dim myFileName As String '探すファイル名(ワイルドカード)
Dim Dummy As String '作業用ファイル名と見つかったファイル名
Dim mySchFileName As String '作業用ファイル名と見つかったファイル名
Dim YMD8old, YMD8new As Long 'ファイルがもつ年月日(比較用)

myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり
myFileName = "*.csv" '月日は4桁

Dummy = Dir(myDir & myFileName)
While Len(Dummy) > 0
YMD8new = ymdHenkan(Dummy)
If YMD8old < YMD8new Then
mySchFileName = Dummy
YMD8old = YMD8new
End If

Dummy = Dir
Wend
If mySchFileName <> "" Then
Workbooks.Open Filename:=myDir & mySchFileName
Else
MsgBox "ファイルがありません"
End If
End Sub

'ファイル名の年月日を8桁にする
Function ymdHenkan(myFileName As String)
Dim wkFLname As String 'ワーク
Dim L As Integer 'カウンタ
Dim yy, mm, dd As String '年、月、日
Dim pot(4) As Integer '「-」の位置
Dim potIdx As Integer '「-」の位置の順

wkFLname = myFileName & "-"
For L = Len(wkFLname) To 1 Step -1
If Mid(wkFLname, L, 1) = "-" Then
potIdx = potIdx + 1
pot(potIdx) = L
End If
If potIdx = 4 Then Exit For
Next
yy = Mid(wkFLname, pot(4) + 1, pot(3) - 1 - pot(4))
mm = Right("0" & Mid(wkFLname, pot(3) + 1, pot(2) - 1 - pot(3)), 2)
dd = Right("0" & Mid(wkFLname, pot(2) + 1, pot(1) - 5 - pot(2)), 2)
ymdHenkan = Val(yy & mm & dd)
End Function

お礼

回答ありがとうございます。早速試みたところ”ファイルが見つかりません！”とダイアログ表示されてしまいました。初歩的な質問で大変申し訳ありませんが、　＞myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり’この１行だけ入れ替えればいいんですよね！？

回答No.1

nishi6

少々条件が・・・
ファイル名の日付（xxx6_19）の意味があいまい（xxxは？）なので月日５桁で考えています。（６月１日は06_01、１２月１日は12_01）９月までが月１桁だと判定に苦しみそうです。ファイル名には年月日以外の数値がないとか別の条件があれば簡単ですが。
また、年をどうされているか分かりませんが、Left(Right(Dummy, 9), 5)を少し変形すれば対応できるでしょう。（今はファイル名から月日を切り取っています）

下記は、月日５桁で一番大きいファイル名を探し、開いています。別シートになります。
この後、
　１．データ→並べ替えで上位５番目までを見る、または
　２．データ→フィルタ→オートフィルタでトップテンを選んで上位または下位５を選択
１または２も自動にする？のはキー記録でできそうですが・・・

コントロールツールボックスのボタンのマクロ。「myDir」を合うように変更してください。

Private Sub CommandButton1_Click()
Dim myDir As String 'ファイルガあるドライブとフォルダ
Dim myFileName As String '探すファイル名(ワイルドカード)
Dim Dummy, mySchFileName As String '作業用ファイル名と見つかったファイル名
Dim chkMD As String 'ファイルがもつ月日

myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり
myFileName = "*.csv"　　　　　　　　'月日は4桁

Dummy = Dir(myDir & myFileName)
While Len(Dummy) > 0
If chkMD < Left(Right(Dummy, 9), 5) Then
chkMD = Left(Right(Dummy, 9), 5)
mySchFileName = Dummy
End If

Dummy = Dir
Wend
If mySchFileName <> "" Then
Workbooks.Open Filename:=myDir & mySchFileName
Else
MsgBox "ファイルがありません"
End If
End Sub

お礼

回答ありがとうございます。内容不十分ですみません。日々更新されるファイル名は「000001-sdfghfj-2001-6-21」といった具合です。データ並び替えは上手くいったんですがフォルダ内より最新ファイル取り出し（検索）が上手くいかず・・