Results of 1 - 1 of about 71 for ExecuteExcel4Macro 閉じた｜開いて｜開かず (0.013 sec.)
executeexcel4macro (140), 閉じた (629), 開いて (4904), 開かず (263)
- [[20140117113301]]
- #score: 14119
- @digest: eab6b59685c10ae0302ab5951be56b0a
- @id: 64285
- @mdate: 2014-06-06T07:55:05Z
- @size: 9169
- @type: text/plain
- #keywords: currentdir (54132), 答納 (15209), 子変 (14900), mydir (11309), chdrive (10263), executeexcel4macro (5972), temp (5508), msofiledialogfolderpicker (3710), 張子 (3580), fn (3498), selecteditems (3444), はxl (3263), filedialog (3178), 納期 (3040), 拡張 (2930), ファ (2397), 2014 (2356), ケタ (1971), ァイ (1856), 列: (1711), イル (1553), string (1448), 変更 (1227), 品番 (1086), seiya (1079), screenupdating (1078), 木) (1053), ォル (1002), ル名 (1000), dir (988), ルダ (858), thisworkbook (852)
- 『フォルダ内の複数のファイルから問題あるものだけ抽出したい』（かもすけ）
はじめまして。 恐れ入りますが、教えて頂きたくお願いいたします。 500個程度のファイルが入っているフォルダがあります。 そのファイルから、問題あるものだけを抽出したいのですが、どのような方法がありますでしょうか。 ＜状況＞ A列:品番、B列:指定納期、C列:回答納期・・・・ 行に関しては取り扱い品番数ごととなるので、3行ですむファイルや、20行あるファイルなどそれぞれです。 ＜やりたいこと＞ C列の回答納期で、8ケタの数字以外をインプットしている場合のみ、新しいファイルに「ファイル名」を記載したい です。 いろんなマクロを組んだのですが、うまく照合できず困っております。 なにとぞお知恵をお貸し頂きたくお願いいたします。 ＜ 使用 Excel:Excel2003、使用 OS:WindowsXP ＞ ---- 500ファイルですか…実用に耐えるかな? 細かいところは置いてますが、新規ブックの標準モジュールへ 以下を貼り付け実行してみてください。 検索対象のファイルが存在しているフォルダは変数ptを変更してください。 Sub sample() Const pt As String = "C:¥test¥" '要変更 Dim i As Long, ii As Long, fn As String, tbl fn = Dir(pt & "*.xls") If fn <> "" Then If vbNo = MsgBox("検索を開始します。", vbYesNo) Then Exit Sub Application.ScreenUpdating = False Do With Workbooks.Open(pt & fn) With .Sheets(1) tbl = .Range("C2:C" & .Range("C" & .Rows.Count).End(xlUp).Offset(1).Row).Value End With If IsArray(tbl) Then For i = 1 To UBound(tbl) If (Not tbl(i, 1) Like String(8, "#")) * (Len(tbl(i, 1))) Then ii = ii + 1 ThisWorkbook.Sheets(1).Range("A" & ii).Value = fn Exit For End If Next i End If .Close False End With fn = Dir() Loop Until fn = "" Application.ScreenUpdating = True End If MsgBox "処理が完了しました。" End Sub （Jera） 2014/01/17(金) 17:32 ---- >Jera様 ご教示有難うございました! 教えていただいた内容を標準モジュールに貼り付け、データの在り処を変更させ実行しましたところ、C列がブランクの場合もNGと出てしまうのか、実行できたすべてのファイルの名前が挙がってしまいました。 また途中で「型が一致しない」とエラーが出て、デバックを見ると「 For i = 1 To UBound(tbl)」の部分がマーキングされていました。 とまってしまったファイルを見ると、見出しの行の他、品番が1つしかない(=1行しかない）状態でした。 何度も申し訳ないのですが、再度やり方を教えていただけませんでしょうか。 恐れ入りますがよろしくお願いいたします。 （かもすけ） 2014/01/20(月) 10:12 ---- 対策が不十分でしたね…。上のコードを変更したので、再度試してみてください。 一行目の見出しは検索に含んでいません。 （Jera） 2014/01/20(月) 11:45 ---- こんにちは。 先日PC入れ替えが行われ、EXCEL2003から2007に変更となりました。 すると、いままで使用できていた、上のマクロがきかなくなりました。 セキュリティ警告はクリアにしております。 マクロを起動すると、本来であれば3分少々かかっていた処理が即「処理が完了しました」と 出てしまい、かつ、該当のファイル名が抽出されていない状況です。 解決策がありましたら、教えていただきたくお願いいたします。 なお、ファイルの場所や名前は変更されておりません。 （かもすけ） 2014/05/15(木) 09:39 ---- >なお、ファイルの場所や名前は変更されておりません。 とのことですが、対象ファイルの拡張子は変わっていないでしょうか。 2007以降の標準拡張子はxlsx もしくはxlsmです。 それが問題であれば fn = Dir(pt & "*.xls") を fn = Dir(pt & "*.xls*") に変更してどうでしょうか。 （Mook） 2014/05/15(木) 09:52 ---- Mook様、ご回答ありがとうございます。 ファイル拡張子はxlsのままで、xlsxのものはxlsに拡張子変更を行っております。 fn = Dir(pt & "*.xls*") に変えてみたのですが、状況は同じでした（涙） ありがとうございます。 （かもすけ） 2014/05/15(木) 10:39 ---- 本題とは関係ないかもしれませんが、 >ファイル拡張子はxlsのままで、xlsxのものはxlsに拡張子変更を行っております。 拡張子変更はどのように行ったのでしょうか? いったんブックを開いてxls形式で保存し直したのでしょうか? それともブックを開かずに拡張子の変更をしただけなのでしょうか? （カリーニン） 2014/05/15(木) 10:47 ---- こんな感じで? シート名が共通なら、開かないで処理できますが? Option Explicit Sub test() Dim myDir As String, fn As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myDir = .SelectedItems(1) & "¥" End With If myDir = "" Then Exit Sub Application.ScreenUpdating = False fn = Dir(myDir & "*.xls") Do While fn <> "" With Workbooks.Open(myDir & fn).Sheets(1) On Error Resume Next If .[sumproduct((len(c1:c10000)<>8)*(len(c1:c10000)>0))] Then ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Value = fn End If On Error GoTo 0 .Parent.Close False End With fn = Dir Loop Application.ScreenUpdating = True End Sub （seiya） 2014/05/15(木) 12:09 ---- seiya様 ご回答、ありがとうございました! マクロ、動きました。 ただ、8桁数字を入れてない、いれてる関係なしに、そのフォルダに入っている ファイル名すべてが表示されてしまいました・・・・・。 なお、sheet名はすべて共通です。 （かもすけ） 2014/05/15(木) 16:04 ---- こんな感じでどうでしょう? Sub test() Dim myDir As String, fn As String, temp As String, x, CurrentDir As String Const sn As String = "Sheet1" '<----実際のシート名に変更 With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myDir = .SelectedItems(1) & "¥" End With If myDir = "" Then Exit Sub CurrentDir = CurDir ChDrive myDir: ChDir myDir fn = Dir(myDir & "*.xls") Do While fn <> "" temp = "'[" & fn & "]" & sn & "'!r1c3:r10000c3" x = ExecuteExcel4Macro("count(if((" & temp & "<>"""")*(len(" & temp & ")<>8)," & temp & "))") If x > 0 Then ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Value = fn End If fn = Dir Loop ChDrive CurrentDir: ChDir CurrentDir End Sub （seiya） 2014/05/15(木) 17:29 ---- seiya様、ご回答ありがとうございます! シート名を変更し、マクロを起動してみたのですが、選択フォルダを 選ぶと、エラー1004 で数式が正しくない （デバックをみると黄色になる部分はこちら） x = ExecuteExcel4Macro("count(if((" & temp & "<>"""")*(len(" & temp & ")<>8)," & temp & "))") と出てしまいます。 何度も申し訳ございません。 （かもすけ） 2014/05/22(木) 09:18 ---- シート名/ファイルパス名に Apostrophe ' が入っていたりしますか? （seiya） 2014/05/22(木) 10:42 ---- seiya様 ご返信ありがとうございました。 sheet名は"納指進捗表"、かつ実際確認したい列はS列なので、以下のとおりに書き換えました。 Sub test() Dim myDir As String, fn As String, temp As String, x, CurrentDir As String Const sn As String = "納指進捗表" With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myDir = .SelectedItems(1) & "¥" End With If myDir = "" Then Exit Sub CurrentDir = CurDir ChDrive myDir: ChDir myDir fn = Dir(myDir & "*.xls") Do While fn <> "" temp = "'[" & fn & "]" & sn & "'!r1s3:r10000s3" x = ExecuteExcel4Macro("count(if((" & temp & "<>"""")*(len(" & temp & ")<>8)," & temp & "))") If x > 0 Then ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Value = fn End If fn = Dir Loop ChDrive CurrentDir: ChDir CurrentDir End Sub ファイルが入っているフォルダは N:¥XXXXX¥〔21〕システム¥《18》システム¥2014010010 というところになります。 （かもすけ） 2014/05/26(月) 15:46 ---- > 実際確認したい列はS列なので temp = "'[" & fn & "]" & sn & "'!r1c19:r10000c19" （seiya） 2014/05/26(月) 17:43 ---- seiya様 ご回答ありがとうございます! そうでしたね、cは変えてはいけませんでしたね。ご指摘ありがとうございます。 こちらに書き換えてマクロを走らせたのですが、保存しているすべてのファイル名が あがってしまいました。 具体的には、回答納期にはyyyymmddという8ケタ数字が入っていてほしくて、m月d日や yyyy/mm/ddと入っているのはNGで、そのファイル名は出てほしいという形です。 何度も申し訳ございません。 （かもすけ） 2014/05/28(水) 14:11 ---- 一番最初のJeraさんのコードは tbl = .Range("C2:C" & .Range("C" & .Rows.Count).End(xlUp).Offset(1).Row).Value ってなっているので、データ行は2行目からの様に感じますが temp = "'[" & fn & "]" & sn & "'!r1c19:r10000c19" これだと、・・・・・・・・・・・・・‾1行目からの範囲になっている様ですが。 また、 x = ExecuteExcel4Macro("count(if((" & temp & "<>"""")*(len(" & temp & ")<>8)," & temp & "))") 部分は、SUMPRODUCT関数にしてみてはどうでしょう? x = ExecuteExcel4Macro("SUMPRODUCT((" & temp & "<>"""")*(len(" & temp & ")<>8))") （HANA） 2014/06/03(火) 08:54 ---- HANA様 ご指摘、ならびにご提案ありがとうございました! 内容を変更してみたところ、無事マクロが起動しました!本当にありがとうございました。 またご協力いただきましたすべての皆様に感謝いたします。 ありがとうございました。 （かもすけ） 2014/06/06(金) 16:55... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201401/20140117113301.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97056 documents and 608292 words.
訪問者：