Results of 1 - 1 of about 13164 for 日付 (0.003 sec.)
- [[20190225113355]]
- #score: 2423
- @digest: 19f518dc3b9d3600c238801da7fba746
- @id: 78744
- @mdate: 2019-03-05T10:38:02Z
- @size: 15658
- @type: text/plain
- #keywords: 注依 (67532), 料手 (41156), cfiles (39240), 頼書 (26563), 付不 (26349), 成日 (12476), 手配 (11149), cpath (9250), 発注 (9133), 不正 (7100), 当日 (6266), 依頼 (6185), 材料 (4402), wscript (4259), 日時 (3050), 日付 (2944), while (2924), 列・ (2870), printout (2819), ダ内 (2746), ープ (2690), officetanaka (2589), ルー (2452), ヒン (2399), 請求 (2208), ォル (2171), 印刷 (2163), ファ (1961), ブッ (1869), ルダ (1859), 2019 (1684), screenupdating (1617)
- 『デスクトップフォルダ内EXCELファイルから文字取得』（たんたん）
はじめまして。 VBA触り始めた者ですが、ちょっと高度でどう作成していいのか、 分かりません。 どうかご教授よろしくお願いします。 希望の動き 1.デスクトップフォルダにあるEXCELファイルを開く 2.そのシート内に特定文字があればそれの1つ右のセル内の文字を sheet1へ書き出す というものです。 デスクトップ上のフォルダ名:発注依頼書 EXCEL:複数ある場合あり 特定文字:材料手配 特定文字はセルA10にあり、取得したい文字はその横(結合しているのでH10) にあります。 可能であればsheet1への書き出しは・・・ A列・・・取得したEXCELファイル名 B列・・・取得したい文字 に書き出せれば、と思っております。 過去記事:20170116220914が近いと思われますが、 どこをどう改良すればいいのか・・・。 分かっていない状態で、ここに書いていますが、 どうぞよろしくお願いします。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- とりあえず、されたいことを整理するとこうなりますよね (1) デスクトップにある「発注依頼書」というフォルダの中にある (2)「●●.xls?」を片っ端から開いて (3)【シートが不明】のA10セルが「材料手配」となっていたら (4)【シートが不明】のH10セルをコピーして (5)「マクロを記述したブック」の「Sheet1」のうち A列・・・・・(4)を貼り付け B列・・・・・(2)で開いたブック名を記入 C列・・・・・【シートが不明】のシート名を記入 (6)開いたブックを閉じる (7)(1)のフォルダ内にある、「●●.xls?」全部で(2)〜(6)を繰り返す ＞VBA触り始めた者 とのことですから、一足飛びにやろうとしても混乱するように思いますので、 （A）特定のフォルダにある「●●.xls?」を全部探す方法 （B）（あらかじめ開いておいた）ブックの各シートを巡回し、A10セルの値を取得（チェック）する方法 （C）ブック間でコピー&ペーストをする方法 (D)ブックを開く方法、閉じる方法 というように部品で考えてから、これらを合体する手順で調べてみてはどうでしょうか。 (A)のヒント http://officetanaka.net/excel/vba/tips/tips107.htm http://officetanaka.net/excel/vba/file/file07.htm (B)のヒント https://www.vba-ie.net/statement/foreachnext.php https://programming-study.com/technology/vba-for-each/ (C)のヒント http://officetanaka.net/excel/vba/cell/cell09.htm (D)のヒント http://officetanaka.net/excel/vba/file/file01.htm http://officetanaka.net/excel/vba/file/file03.htm （もこな2） 2019/02/25(月) 12:56 ---- "発注依頼書" というフォルダ下に、更にサブフォルダが複数あって…、という状況でないならば、参照先の私のコードを使う必要性はなく、もこな2さんの案内に従って、Dir関数でコーディングすれば良いですよ。 それが基本的な方法です。 とりあえず、参考用。 Sub test() Dim wk As Worksheet Dim cFiles As Variant Dim cPath As String Dim iR As Long Dim iw As Long Dim i As Long Application.ScreenUpdating = False Set wk = Sheets("Sheet1") wk.Cells.ClearContents cPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥発注依頼書¥" cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPath & "*.xls*""").StdOut().ReadAll(), vbNewLine) For i = 0 To UBound(cFiles) - 1 If InStr(cFiles(i), "$") = 0 Then With Workbooks.Open(cFiles(i), False, True) With .Sheets(1) If .Range("A10") = "材料手配" Then iw = InStrRev(cFiles(i), "¥") iR = iR + 1 wk.Cells(iR, "A").Value = Mid(cFiles(i), iw + 1) wk.Cells(iR, "B").Value = .Range("H10") End If End With .Close False End With End If Next i Application.ScreenUpdating = True End Sub （???） 2019/02/25(月) 15:02 ---- もこな2さん 参考のヒントありがとうございます。 まだヒントをほぼコピーで持ってきてどんなんか試し中です。 Sub test1() Dim buf As String, cnt As Long Const Path As String = "C:¥Users¥test¥Desktop¥発注依頼書¥" buf = Dir(Path & "*.xlsx") Do While buf <> "" cnt = cnt + 1 Cells(cnt, 1) = buf buf = Dir() Dim MyR As Range 'オブジェクト変数にRangeを指定' Range("A20").Select For Each MyR In Selection 'Selection内のセルを操作対象とする' Worksheets("Sheet1").Range("H10").Copy Worksheets("Sheet2").Range("H10") Next MyR Loop MsgBox ("終了") End Sub まだ全然動けていません。 ファイル名取得で少し喜んでいる段階・・・。レベルがバレてしまう＞＜ まだまだ。 （たんたん） 2019/02/25(月) 15:35 ---- Sheet1からSheet2にコピーするのではなく、開いたブックのどこかのシート（どこですか?）から、自ブックのSheet1にコピーですよね? ブックを開く部分が無いようですよ。 （???） 2019/02/25(月) 15:54 ---- ???さん 大変遅くなり、申し訳ございません。 ???さんのコードで動き、そのデータの流れを追っているところです。 VBAにコマンドを組み合わせており・・・思いつかないどころか、 こんなこともできるのか!と。 これで動きはできると思った中、もう1つ要件課題を言われ、 思いつくコードを追記しました。(***↓↓↓以降) Sub test() Dim wk As Worksheet Dim cFiles As Variant Dim cPath As String Dim iR As Long Dim iw As Long Dim i As Long Dim d1 As String Dim dt1 As Date Dim dt2 As Date Application.ScreenUpdating = False Set wk = Sheets("Sheet1") wk.Cells.ClearContents cPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥発注依頼書¥" cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPath & "*.xls*""").StdOut().ReadAll(), vbNewLine) For i = 0 To UBound(cFiles) - 1 If InStr(cFiles(i), "$") = 0 Then With Workbooks.Open(cFiles(i), False, True) With .Sheets(1) If .Range("A10") = "材料手配" Then'資材・建材在庫確認FLG iw = InStrRev(cFiles(i), "¥") iR = iR + 1 wk.Cells(iR, "A").Value = Mid(cFiles(i), iw + 1) wk.Cells(iR, "B").Value = .Range("H10") End If End With '*** ↓↓↓ d1 = .Range("I1") '格納資料の作成日付と当日以降の日付チェック(デグレ防止) dt1 = CDate(Format(d1, "yyyy/mm/dd")) dt2 = Date '当日日付 If dt1 >= dt2 Then wk.Cells(5, 3).Value = dt1 Debug.Print "OK" .PrintOut '.Close False wk.PrintOut Else MsgBox ("日付がおかしいファイル有り!"), vbCritical End If End With .Close False End With End If Next i Application.ScreenUpdating = True End Sub 当日より古い(過去)発注書は仮に発注依頼書フォルダに入っていても 印刷しないようにしたかったのですが、分からず。 分かる範囲で調べて過去日付があれば、メッセージを出すようにしました。 が、これでいくと過去の発注書は印刷しませんが、 当日より新しい発注書は印刷されてしまいます。 今はそのメッセージが出力すれば、発注依頼書フォルダ内を確認し、 不要分を取り除き、再度実行するように報知しています。 できれば、過去の発注書が入っていた場合は読み飛ばす 当日以降未来分のみを印刷するようにって可能でしょうか? 頼り切りで申し訳ございませんが、再度ご教授お願いできますでしょうか。 （たんたん） 2019/03/01(金) 19:07 ---- d1が作成日付だとすると、d1とd2の大小関係判定が逆ではないですか? それだけで目的を果たせるように思います。（d1の代入時、.Sheets(1)のWithが終わっているので、エラーになりそうですが?） また、手入力された日付を使う方法以外に、ファイルの更新日時を使う方法と、ブックの最終保存日時を使う方法があります。 手入力だと入力忘れがあったりしないでしょうか? （???） 2019/03/04(月) 09:04 ---- ???さん ご回答、ありがとうございます。 ＞d1が作成日付だとすると、d1とd2の大小関係判定が逆ではないですか? テストを行っているのですが、特にこれで大丈夫と思っています。 d1が作成日付(どうやら請求予定日らしい) d2が当日日付 であるので If dt1 >= dt2 Thenであり、当日以降未来分が出力OKとしたいので 2/28 3/4 の場合は出力NG 3/5 3/5 の場合は出力OK となります。 ＞（d1の代入時、.Sheets(1)のWithが終わっているので、エラーになりそうですが?） 発注依頼書フォルダ内に作成日付が2/28,3/4,3/5の3シートがあったとします。 これで実行した場合、 2/28,3/1作成日付分はNGのメッセージ出力し印刷はされませんが、 3/5作成日付分のデータは印刷されてしまいます。 Exit Subで抜ければいいのでしょうが、既に印刷がかかったものは印刷されてしまいます。 しかし、運用を考えるとNGがなければ印刷するの方がという声が出そうと懸念しています。 ただし、それにはどうすればというのが知識不足で分かりません。 よって今は過去請求予定日分(2/28,3/1分)を取り除いて再処理かけると展開しようとしています。 ＞手入力だと入力忘れがあったりしないでしょうか? d1に作成日付が入りますがここは経理部が入力しています。 ファイル更新日時/ブック保存日時でもと思いましたが、 実際は経理担当がコントロールしており、一概にファイル更新日時 = 作成日付 ではないようです。 （たんたん） 2019/03/05(火) 09:26 ---- 印刷日時を記録してはいかがでしょうか? 請求予定日と当日だけの比較では、既に印刷済みか判断できませんから。（対象ブック内に持つか、印刷用マクロブックにファイル一覧表を作成し、ここに持つか…） （???） 2019/03/05(火) 09:52 ---- ???さん 初心者的発想かもしれませんが・・・ 1.まずは発注依頼書フォルダ内の各ブックを開いて日付チェック 2.請求日付的に問題なければ、教えていただいているコードで印刷 と2段階しか思いつきませんでした。 その上で〜 Sub test() Dim wk As Worksheet Dim cFiles As Variant Dim cPath As String Dim iR As Long Dim iw As Long Dim i As Long Dim d1 As String Dim dt1 As Date Dim dt2 As Date Application.ScreenUpdating = False Set wk = Sheets("Sheet1") wk.Cells.ClearContents cPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥発注依頼書¥" cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPath & "*.xls*""").StdOut().ReadAll(), vbNewLine) '***お試し Do While i < UBound(cFiles) - 1 If InStr(cFiles(i), "$") = 0 Then With Workbooks.Open(cFiles(i), False, True) With .Sheets(1) d1 = .Range("H10") '発注依頼書の請求日付 dt1 = CDate(Format(d1, "yyyy/mm/dd")) dt2 = Date '当日日付 If dt1 < dt2 Then MsgBox ("日付がおかしいファイル有り!"), vbCritical End With .Close False End With End If 'Next i i = i + 1 Loop i = 0 '***お試し終了 For i = 0 To UBound(cFiles) - 1 If InStr(cFiles(i), "$") = 0 Then With Workbooks.Open(cFiles(i), False, True) With .Sheets(1) If .Range("A10") = "材料手配" Then'資材・建材在庫確認FLG iw = InStrRev(cFiles(i), "¥") iR = iR + 1 wk.Cells(iR, "A").Value = Mid(cFiles(i), iw + 1) wk.Cells(iR, "B").Value = .Range("H10") End If End With '*** ↓↓↓ d1 = .Range("I1") '格納資料の作成日付と当日以降の日付チェック(デグレ防止) dt1 = CDate(Format(d1, "yyyy/mm/dd")) dt2 = Date '当日日付 If dt1 >= dt2 Then wk.Cells(5, 3).Value = dt1 Debug.Print "OK" .PrintOut '.Close False wk.PrintOut Else MsgBox ("日付がおかしいファイル有り!"), vbCritical '←ここがいるかどうか End If End With .Close False End With End If Next i Application.ScreenUpdating = True End Sub 有識者から見ると、コードが汚いかもしれませんが どうでしょうか?(逆質問ですいません) （たんたん） 2019/03/05(火) 12:29 ---- と書きましたが、一部修正と追記となります。 ＜修正＞ 修正前:Do While i < UBound(cFiles) - 1 修正後;Do While i < UBound(cFiles) ＜追記＞ Do While〜Loop内でNGがあれば処理を終わらせたいのですが、ここが分かりません。 (NGがあれば全てを印刷させないようにしたいため) Loop抜けた直後にEndとするとそこで処理が終了してしまいますし・・・。 何かいい方法ありますでしょうか? （たんたん） 2019/03/05(火) 12:49 ---- 駄目な点を列挙します。 ・段付けが変。そのせいか、With文がひとつ多くないですか? これ、動きますか?（回答者にデバッグさせないように） ネストが汚いソースは、人に見せてはいけません。 ・ForループとWhileループ。やっていることは同じなのに、2つの命令を使うのは変。 Whileループはミスすると無限ループする可能性があるので、この場合はForループに統一すべき。 （それとも、Whileループを使わなければいけなかった理由があるのですか?） ・「お試し」部分で日付不正があるとMsgBox表示しますが、その後、そのまま印刷処理に流れるので、メッセージの意味なし。 そもそも、このメッセージを見ても、どのファイルが不正だったのか判断できない。 （不正を見つけたら中断ならば、ブックをClose後、Exit Subすれば良いですが、複数のブックに日付不正がある可能性は無いのですか?） 改善案。 ・日付判定だけでループさせず、「材料手配」判定と日付の抜き出しをまとめれば1つのループになるでしょう。 ・日付情報と判定結果はMsgBox表示せず、C列以降にセットして最後までループを通す。そうすれば、一覧の中に判定結果が表示されるので、 複数不正ファイルがあってもいちいち中断せず、1回で判るでしょう。 ・このプロシジャではPrintOutは行わず、作成した一覧を元にループし、判定OKなものだけ全部印刷する別プロシジャを作成した方が、 運用が楽になりませんか? （???） 2019/03/05(火) 13:26 ---- ???さん 色々ご指摘、ありがとうございます。 段付けについては今から修正します。 確かにどことどこをくくっているのか、迷いますね。 とりあえず、まずは動かすこと!という意識があるようでした。 For/Whileについてはあまり意識はしていませんでした。 自分の思いと検索でやりたい事でWhileが出てきて・・・。 無限ループまで意識していませんでした。ちょっと危なかったです。 日付不正時のMSG出力後について、フォルダ内全て確認し 本当はそこで終了させたいのですが・・・ 全然分かっていないんで、今はエラーMSG出力させて処理を止めてしまう方向で。 エラーのあったファイル名は If dt1 < dt2 Then MsgBox ("日付がおかしいファイル有り!" & vbLf & cFiles(i) & vbLf), vbCritical これでファイル名は表示させようと思っています。 ＞（不正を見つけたら中断ならば、ブックをClose後、Exit Subすれば良いですが、 ＞複数のブックに日付不正がある可能性は無いのですか?） そうですね、まさに複数ファイルあることが多いので、なかなか上手くいっていません。 （たんたん） 2019/03/05(火) 17:49 ---- 複数の日付不正対応は、改善案に書いた通りですので、考えてみてください。 余談ながら、While文が危ないよ〜、というのは、今回はループ内で i = i + 1 としてますよね。 例えばこの行を間違えて消してしまったりとか、プラストマイナスを間違えたとかすると、いつまでたっても抜ける条件が成立せず、無限ループに陥る訳です。 間違えなければ問題ないですし、心配ならループの内側にDoEventsを1行入れておけば、マクロを停止することができます。 Forループの場合、ループ回数に到達すれば抜けるので、ミスしても全然処理しないか、最後までループするかになるので、安全なのですよ。 また、テキストファイルを1行ずつ読み込む場合のように、何行あるか途中では判断できないような場合にはWhile文が有効なので、使いどころを考えましょう。 （???） 2019/03/05(火) 18:18 ---- ???さん 何度もありがとうございます。 改善案については、まだまだ勉強とテストを繰り返さないと 理解できるには程遠く、もう少しお時間いただきます。 分かっていない中でのWhile文の無限ループに入ったときには 落ち着いて「Ctrl+Pause」を押す事、覚えておきます。 今は動く!で喜んでいますが、次は使いどころを見極めて使えるよう がんばります。 (内容に対する返信にはなってないかも・・・) （たんたん） 2019/03/05(火) 19:38... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201902/20190225113355.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97044 documents and 608215 words.
訪問者：