-PR-
解決
済み

VBAでしょうか!?

  • 困ってます
  • 質問No.92783
  • 閲覧数110
  • ありがとう数7
  • 気になる数0
  • 回答数6
  • コメント数0

お礼率 42% (8/19)

フォルダの中には日付(xxx6_19)がファイル名の複数のCSVファイルがあります。
エクセルでメニュー画面を作成しワンクリックで当フォルダ内の一番最近のファイルを開き、尚且つ1つの項目を並び替えて上位5位までを表示させる方法を教えて下さい!
通報する
  • 回答数6
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.6
レベル13

ベストアンサー率 68% (791/1163)

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

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 "CVSファイルがありません": Exit Sub
End If
If CsvFileCot > 1 Then
MsgBox "CVSファイルが複数あります。中断します": Exit Sub
End If
'元のシートから読み込んだCVSファイルを操作
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
お礼コメント
keyman

お礼率 42% (8/19)

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

その他の回答 (全5件)

  • 回答No.1
レベル13

ベストアンサー率 68% (791/1163)

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

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

コントロールツールボックスのボタンのマクロ。「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
お礼コメント
keyman

お礼率 42% (8/19)

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


  • 回答No.2
レベル13

ベストアンサー率 68% (791/1163)

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

お礼率 42% (8/19)

回答ありがとうございます。早速試みたところ”ファイルが見つかりません!”とダイアログ表示されてしまいました。初歩的な質問で大変申し訳ありませんが、 >myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり’この1行だけ入れ替えればいいんですよね!?
投稿日時 - 2001-06-22 20:50:58
  • 回答No.3
レベル13

ベストアンサー率 68% (791/1163)

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

多分、そうされてのことだと思い、なぜ動かないか考えてみました。
私は、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
お礼コメント
keyman

お礼率 42% (8/19)

事細かく回答頂き本当にありがとうございます。
しかし解決されませんでした・・・前回と同じように「ファイルが見つかりません」と表示されます。おっしゃるように拡張子は表示していませんでした。で表示させて試みてもダメでした・
投稿日時 - 2001-06-23 00:13:05
  • 回答No.4
レベル13

ベストアンサー率 68% (791/1163)

拡張子(.csv)があるようなのでANO.#2を使います。 確認ですが、ご自分のフォルダを指定してください。\あり」 の「ご自分のフォルダ」はcsvファイルがあるフォルダです。「\あり」は「C:\xxxxx\xxxxx\」のように登録して最後に「\」が必要ということです。 また、下記の様にしてみて下さい。実行した後、イミディエイトウインドウ(もしくはデバッグウインドウ)を開いて、開こうとしたファイ ...続きを読む
拡張子(.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
お礼コメント
keyman

お礼率 42% (8/19)

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

ベストアンサー率 68% (791/1163)

ANo#2に下記の4行を追加し実行結果のイミディエイトウインドウの内容を補足して下さい。最初の2、3件と最後の2、3件を見たいので、途中はカットしてもらってかまいません。それに、ダイアログのメッセージは私の作ったダイアログの文言でしょうか。 myDir = "C:\My Documents\" 'ご自分のフォルダを指定してください。\あり myFile ...続きを読む
ANo#2に下記の4行を追加し実行結果のイミディエイトウインドウの内容を補足して下さい。最初の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
お礼コメント
keyman

お礼率 42% (8/19)

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

ファイルの内容は

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

といった具合に配列してあります。
投稿日時 - 2001-06-24 13:32:19
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ