Results of 1 - 1 of about 13158 for 日付 (0.003 sec.)
- [[20130722090843]]
- #score: 2423
- @digest: d22b53ce98f83cf607e2d0811af202e3
- @id: 62991
- @mdate: 2013-07-23T06:31:49Z
- @size: 14602
- @type: text/plain
- #keywords: strfname (258940), fdlg (71126), aaaabbcc (56447), mmddyyyy (55646), filedate (50476), leostream (49751), datawb (41443), kekka (36855), sita (30463), yyyymmdd (19699), selecteditems (14927), 数カ (8898), instrrev (7965), dstws (6412), vw (5580), タル (5080), dateserial (4731), filedialog (4237), カウ (3666), ル数 (3293), 日付 (3213), ト( (3043), yyyy (2859), vbcrlf (2617), ファ (2398), ウン (2232), トー (2167), right (1896), ァイ (1857), り出 (1785), 行数 (1743), と行 (1725)
- 『ファイル名から文字を抜き出す』（ぐりむ）
元スレ[[20130718114809]] ↑のマクロについて考えていますが、 分からないことばかりで完成せず。。 再度スレを作りました。 ファイル名から「YYYYMMDD」の部分だけを抜き出したいのですが、 どうしたら良いでしょうか? 現在のマクロでは、StrFnameを使っています。 とりあえずその部分だけを抜き出し、試行錯誤して完成させたいです。 どなたかご教授お願いします。 Excel2003/XP ---- ファイル名 StrFname が CADyyyymmdd.csv (yyyymmdd は8桁の日付)固定の形なら 年は Mid( StrFname,4,4) で取り出せるかと思います。 http://excelvba.pc-users.net/func/func3.html 同様に 月、日 が取り出せれば 日付型に変換するには DateSerial(年,月,日) CDate( 年 & "/" & 月 & "/" & 日 ) などで できないでしょうか。 http://www.eurus.dti.ne.jp/‾yoneyama/Excel/vba/function/vba_date.html まず、VBA でどんな関数があるのか（全部が無理でも今回の目的なら日付関数、 文字列操作関数）をヘルプやウェブで一覧に目を通しておいてはどうでしょうか。 http://officetanaka.net/excel/vba/function/ (Mook) ---- Mookさんありがとうございます。 色々探してサイトに載っているものを試してみたりしてはいますが、 希望通りのものが出来ず。。orz StrFname = "*¥leostream_????????.csv" StrFname = InStrRev("*¥leostream_????????.csv", "¥", 24) StrFname = Mid(strSamp, 10, 10) 'YYYYMMDDを取り出している? こんな風になっています。(現在の所) 絶対最初のStrFnameのあたりも違うような気がするのですが、 ううん、やっぱり分かりません。 Mookさんが教えてくださったサイトを参考にしてみます。 とりあえずまだまだ試そうと思います・・orz (ぐりむ) ---- まずは関数の仕様を理解することからですね。 InStrRev は「文字位置」を返す関数で、文字を返す関数ではありません。 Mid の第3引数は切り出す文字数です。 いずれもヘルプやウェブで説明はたくさん見つかりますよね? 手を動かさないよりは100倍はましですけれど、説明も一度きちんと見てくださいね。 当初の説明とファイル形式が異なっていそうですが、 StrFname = "C:¥SampleFolder¥dummy1¥dummy2¥leostream_20130722.csv" yyyymmdd = Mid(StrFname, InStrRev(StrFname, "¥") + 11, 8) MsgBox yyyymmdd でどうでしょうか。 yyyymmdd = Mid(StrFname, InStrRev(StrFname, "¥") + 11, 8) は yyyymmdd = Mid(StrFname, InStrRev(StrFname, "_") + 1, 8) でも良いかもしれません。 (Mook) ---- こんな方法もあり。 Sub test() Const StrFname = "C:¥SampleFolder¥dummy1¥dummy2¥leostream_20130722.csv" Dim yyyymmdd As String Dim vw As Variant vw = Split(StrFname, ".") yyyymmdd = Right(vw(UBound(vw) - 1), 8) MsgBox yyyymmdd End Sub (???) ---- 前質問の StrFname = StrFname & FDlg.SelectedItems.Item(i) & vbCrLf ↓ StrFname = StrFname & Replace(Dir(FDlg.SelectedItems.Item(i)), ".csv", "") & vbCrLf とすれば? ---- >>Mookさん 説明も読んでいても理解できず活かせない状態です。。orz 職場の方にInStrRev関数があると言われて初めていじったのですが、 実際このマクロを作るのに必要なのか分からなかったです。。 Midなどは、マクロではなくExcelのセルで何度も使ったことがあり、 それは分かるのですがマクロで書くのとまた違うのかさっぱりです。。 無知な自分をとても恥ずかしく思ってきました。。 yyyymmdd = Mid(StrFname, InStrRev(StrFname, "¥") + 11, 8) を使用してみたところ、きちんと日付が表示されました。 複数ファイル選択することもあるので、繰り返し処理をいれれば通常に実行できると思います。 +表示された日付以外の日付をカウントするものを入れたいと思います。 サイトや関数など教えて頂き本当にありがとうございますm(__)m >>???さん マクロを試してみた所、0722としっかり表示できました! 前作業で選んだファイル名から日付を取れるように、 これを使って希望のマクロに出来るようにいろいろ工夫してみます。 >>前質問の〜を答えてくださった方 StrFname = StrFname & FDlg.SelectedItems.Item(i) & vbCrLf のところを変更してみました! まだファイルを選んでそれが使うべきファイルなのか判断するマクロしか出来上がってないので、 この先の作業で変化がわかると思います。。(日付を取るマクロが出来ていないため) 沢山の方が回答してくださり助かります、本当に(T_T) もう少ししっかり勉強して色々試したいと思います。。 教えてくださった日付を取るマクロに、今後は繰り返し処理を追加して、 その後その日付以外の日付の行数をカウントするように作りたいと思います。 (ぐりむ) ---- 単に8桁の数字を取り出すなら StrFname = "C:¥SampleFolder¥dummy1¥dummy2¥leostream_20130722.csv" With CreateObject("VBScript.RegExp") .Pattern = "¥d{8}" If .test(StrFname) Then MsgBox .Execute(StrFname)(0) End If End With (seiya) ---- >>seiyaさん レスありがとうございます! 皆さんのレスのおかげで日付を取り出すところまでは、 なんとか上手くいきました。 お礼を申し上げます。m(__)m 元レスから、 マクロ自体は全体が完成したのですが、 実行してみると何故かトータル数が0。 それはファイル名から取った日付が20130705なのに対し、 カウントをするブックの日付は07/05/2013 8:36:24- のように、 書式というか書き方が違うからカウントしてくれないのかな。 という失敗?ミス?に陥りました。 現在ファイル名に/スラッシュを入れてDimなど使ったりと、 なんとかカウントするブックに対応するように試行錯誤しています。 (07/05/2013という形には出来たのですがまだトータルは0です。。) あとちょっとのところで上手くいかず。。 とりあえずもう少しなので諦めないで頑張ろうと思います。 (ぐりむ) ---- まずは取出しが出来て何よりですが、カウントに関しては日付データとしての取り扱い の問題だと思いますが、一度現在のマクロのコードを提示してはどうでしょう。 単純な不等号でも比較は出来ると思いますけれど、DateDiff を使うほうがお行儀が良いでしょうか。 (Mook) ---- 全然整っているマクロでもないので、 間違っているところやいらんところがあると思いますが、 とりあえず現在のところのマクロです。 Sub CSVファイルを選ぶ() Dim FDlg As FileDialog Set FDlg = Application.FileDialog(msoFileDialogFilePicker) With FDlg.Filters .Clear .Add "CSVファイル", "*.csv" End With Dim i As Integer Dim StrFname As String FDlg.Show If FDlg.SelectedItems.Count Then For i = 1 To FDlg.SelectedItems.Count StrFname = StrFname & FDlg.SelectedItems.Item(i) & vbCrLf StrFname = FDlg.SelectedItems.Item(i) If StrFname Like "*¥leostream_????????.csv" Then 'MsgBox StrFname & "は対象ファイルです" 'メッセージを出しても出さなくても Call 日付と行数カウント(StrFname) End If Next i End If 'If FDlg.SelectedItems.Count Then MsgBox "選択したファイル" & vbCrLf & StrFname 'これは写さなくても良い Set FDlg = Nothing End Sub Sub 日付と行数カウント(StrFname As String) Dim yyyymmdd As String Dim vw As Variant Dim KEKKA As Long Dim HENKAN As Long Dim SITA As Long Dim mmddyyyy As String vw = Split(StrFname, ".") AAAABBCC = Right(vw(UBound(vw) - 1), 8) mm = Mid(AAAABBCC, 5, 2) dd = Right(AAAABBCC, 2) yyyy = Left(AAAABBCC, 4) mmddyyyy = mm & "/" & dd & "/" & yyyy Workbooks.Open StrFname Columns("E:E").Select Selection.Copy ActiveWorkbook.Close Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste HENKAN = Application.Date(Mid(A2, 7, 4), Mid(A2, 1, 2), Mid(A2, 4, 2)) KEKKA = Application.WorksheetFunction.CountIf(ActiveSheet.Columns(5), "<" & mmddyyyy) SITA = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(SITA, 1).Value = mmddyyyy Cells(SITA, 2).Value = KEKKA End Sub 問題点は、マクロを書いたブックに日付とトータル数を書くのですが、 日付は表示OK、トータル数は何故か0→日付の表示方法が違うからカウントしてくれない? ということです。 職場の方には、 KEKKA = Application.WorksheetFunction.CountIf(ActiveSheet.Columns(5), "<" & mmddyyyy) ここをきちんとDATEの〜に変えれば数えてくれるんじゃないということでしたが、 まだきちんと分かっていないです。 (ぐりむ) ---- KEKKA = Application.WorksheetFunction.CountIf(ActiveSheet.Columns(5), "<" & DateSerial(YYYY, mm, dd)) (???) ---- >>???さん ???さんが書いてくださったKEKKA = 〜以下略のところを使わせて頂いて、 Sub 日付と行数カウント(StrFname As String) Dim yyyymmdd As String Dim vw As Variant Dim KEKKA As Long Dim SITA As Long Dim mmddyyyy As String vw = Split(StrFname, ".") AAAABBCC = Right(vw(UBound(vw) - 1), 8) mm = Mid(AAAABBCC, 5, 2) dd = Right(AAAABBCC, 2) YYYY = Left(AAAABBCC, 4) mmddyyyy = mm & "/" & dd & "/" & YYYY Workbooks.Open StrFname KEKKA = Application.WorksheetFunction.CountIf(ActiveSheet.Columns(5), "<" & DateSerial(YYYY, mm, dd)) ActiveWorkbook.Close SITA = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(SITA, 1).Value = mmddyyyy Cells(SITA, 2).Value = KEKKA End Sub こんな風にやってみましたが、 やっぱりトータル数は0と。。。orz ちなみに、カウントするブックの日付表示のところはE列に、 「07/03/2013 - 08:29:56」のような表示になっています。 どこかマクロが抜けているのかなとか 色々考えるのですが何故カウントしてくれないのか謎です。。 (ちなみにデバッグでF8押しながら辿っていったのですがどこが間違っているのかさっぱりです、、) (ぐりむ) ---- 「07/03/2013 - 08:29:56」のような表示になっています。 は日付の書式ではなく、文字列になっているのでしょうか（セルの書式で確認してください。） 文字列になっているのであれば、日付に変換する例です。 (Mook) Sub 日付と行数カウント(StrFname As String) Dim vw vw = Split(StrFname, ".") Dim YYYYMMDD As String YYYYMMDD = Right(vw(UBound(vw) - 1), 8) '// 日付部分の文字列の切り出し Dim YYYY As Long Dim MM As Long Dim DD As Long YYYY = CLng(Left(YYYYMMDD, 4)) '// 年を数値として取り出し MM = CLng(Mid(YYYYMMDD, 5, 2)) '// 月を数値として取り出し DD = CLng(Right(YYYYMMDD, 2)) '// 日を数値として取り出し Dim dstWS As Worksheet Set dstWS = ActiveSheet Dim dataWB As Workbook Set dataWB = Workbooks.Open(StrFname) '// 引数のファイルを開いて変数にセット Dim fileDate As Date fileDate = DateSerial(YYYY, MM, DD) '// ファイル日付のシリアル値 Dim d As Range Dim KEKKA As Long KEKKA = 0 With dataWB.Worksheets(1) For Each d In Intersect(.Columns(5), .UsedRange) '// E 列のデータを順次処理 If IsDate(Left(d.Value, 10)) = True Then '// 先頭の10文字が日付だったら If CDate(Left(d.Value, 10)) < fileDate Then KEKKA = KEKKA + 1 '// 文字列を日付（シリアル値）に変換して比較 End If Next End With dataWB.Close SaveChanges:=False With dstWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) .Value = fileDate .NumberFormatLocal = "dd/mm/yyyy" .Offset(0, 1).Value = KEKKA End With End Sub ---- >>Mookさん 文字列になっていました。。 Mookさんのマクロを試してみた所、 ビックリするくらい希望通りの結果になっています! '//〜となっているところを参考にして、 どこがダメだったか考えてみます! 本当に最初から最後までありがとうございます(T_T) 結果が最後に選んだファイルが1番上に来てしまう、 日付 トータル数 7/12 〜〜 7/5 〜〜 7/6 〜〜 7/7 〜〜 となっているので、これだけは自力で並び替えたいと思います。 結局皆さんに助けられてばっかりで申し訳なかったです。。 基本も知らずに色々やろうとして全然分かってないことを痛感しましたorz VBAの大事典を職場の方にお借りしましたので、 当分の間はこれで基礎から身につけたいと思いますo(^o^)o 何か問題点がないか、最終的に確認し、 しっかり完成いたしましたらまたスレを書きたいと思います。 (ぐりむ) ---- 最終的に、以下のように仕上がりました! 追加したもの→並び替えとクリア。 とりあえずまた上司に見せたわけでもないので、 なにか見つけ次第対処しながら完全体に仕上げたいと思います。 (ぐりむ) Sub CSVファイルを選ぶ() Dim FDlg As FileDialog Set FDlg = Application.FileDialog(msoFileDialogFilePicker) With FDlg.Filters .Clear .Add "CSVファイル", "*.csv" End With Dim i As Integer Dim StrFname As String FDlg.Show If FDlg.SelectedItems.Count Then For i = 1 To FDlg.SelectedItems.Count StrFname = StrFname & FDlg.SelectedItems.Item(i) & vbCrLf StrFname = FDlg.SelectedItems.Item(i) If StrFname Like "*¥leostream_????????.csv" Then Call 日付と行数カウント(StrFname) End If Next i End If 'If FDlg.SelectedItems.Count Then MsgBox "選択したファイル" & vbCrLf & StrFname Set FDlg = Nothing End Sub Sub 日付と行数カウント(StrFname As String) Dim vw vw = Split(StrFname, ".") Dim YYYYMMDD As String YYYYMMDD = Right(vw(UBound(vw) - 1), 8) '// 日付部分の文字列の切り出し Dim YYYY As Long Dim MM As Long Dim DD As Long YYYY = CLng(Left(YYYYMMDD, 4)) '// 年を数値として取り出し MM = CLng(Mid(YYYYMMDD, 5, 2)) '// 月を数値として取り出し DD = CLng(Right(YYYYMMDD, 2)) '// 日を数値として取り出し Dim dstWS As Worksheet Set dstWS = ActiveSheet Dim dataWB As Workbook Set dataWB = Workbooks.Open(StrFname) '// 引数のファイルを開いて変数にセット Dim fileDate As Date fileDate = DateSerial(YYYY, MM, DD) '// ファイル日付のシリアル値 Dim d As Range Dim KEKKA As Long KEKKA = 0 With dataWB.Worksheets(1) For Each d In Intersect(.Columns(5), .UsedRange) '// E 列のデータを順次処理 If IsDate(Left(d.Value, 10)) = True Then '// 先頭の10文字が日付だったら If CDate(Left(d.Value, 10)) < fileDate Then KEKKA = KEKKA + 1 '// 文字列を日付（シリアル値）に変換して比較 End If Next End With dataWB.Close SaveChanges:=False With dstWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) .Value = fileDate .NumberFormatLocal = "yyyy/mm/dd" .Offset(0, 1).Value = KEKKA End With SITA = Cells(Rows.Count, 1).End(xlUp).Row + 1 Range(Cells(5, 1), Cells(SITA, 2)).Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal '並べ替えする Application.ScreenUpdating = True '作業終了だから画面ON End Sub Sub クリア() Range("A6:B1000").Select Range("B1000").Activate Selection.Delete Shift:=xlToLeft ActiveWindow.ScrollColumn = 1 ActiveWindow.ScrollRow = 1 End Sub... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201307/20130722090843.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97035 documents and 608021 words.
訪問者：