Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)
vba (14717), 強制終了 (237)
- [[20210912021517]]
- #score: 16177
- @digest: 9d7404465d32254fb66b63ca3bc2058b
- @id: 88960
- @mdate: 2021-09-15T16:29:17Z
- @size: 14128
- @type: text/plain
- #keywords: consolidate (16782), 号", (12725), 居z (11637), 隠居 (7003), 数") (6600), multiselect (6010), adr (5479), 記号 (4087), getopenfilename (3673), 点数 (3147), 2021 (3109), マナ (2856), 列: (2852), ナ様 (2728), 実験 (2410), thisworkbook (2346), 統合 (2196), currentregion (2105), ブッ (1973), ファ (1962), （隠 (1858), workbooks (1808), 集計 (1773), 多分 (1763), が, (1755), セス (1637), 月) (1588), xlsx (1556), 教示 (1555), ァイ (1519), wb (1464), usedrange (1455)
- 『複数ブック:記号のカウントと値の合計』（とりにく）
同一フォルダ内にある複数ブックの指定範囲に記載された内容のカウント・合計を自動で行いたく存じます。自分ではどうにもできませんでした。ご教示のほどよろしくお願いいたします。 == 集計対象の各ブックの記載内容 A列:同じ英数字 B列:○ か -（記号） C列:数字（整数） ↓↓集計↓↓ これを行いたいです。 集計先のブック（完成形） A列:同じ英数字（そのまま） B列:2行目以降の○ の個数 C列:2行目以降の数字の合計 == イメージは下記のようになります。 == A B C [ブック1] 1 番号 記号 点数 2 z01 ○ 3 3 z02 - 1 4 z03 - 1 A B C [ブック2] 1 番号 記号 点数 2 z01 - 2 3 z02 - 2 4 z03 - 1 ↓↓集計↓↓ これを行いたいです。 A B C [集計(完成形)] 1 番号 記号 点数 2 z01 1 5 3 z02 0 3 4 z03 0 2 == どうぞよろしくお願いいたします。 ＜ 使用 アプリ:Excel2021(ver 16.52, for Mac)、使用 OS:macOS BigSur ＞ ---- データの統合（合計）で可能と思います。 https://allabout.co.jp/gm/gc/297748/ 記号の合計については、例えば各シートのD列に =IF(B2="〇",1,0) として、記号を数値化しておき、それも含めて集計してから、 集計後のブックを整形すれば提示のレイアウトの様に出来ました。 （qwerty） 2021/09/12(日) 07:00 ---- qwerty様 ありがとうございます。 記号を数値化する方法は考えつきませんでした。 集計するエクセルのブック数が100を超えるため,すべてを開いて統合（合計）するのは大変なので,VBAなどで一連の操作を自動化する方法をご教示いただけないでしょうか。自分では記述できませんでした。 ちなみに,A‾C列の入力内容は150行程度あります。 お力添えのほどお願いできますでしょうか。 （とりにく） 2021/09/13(月) 10:18 ---- こんにちは ^^ 多分。Macでは連想配列が使えないとの、話を聞いたことがあります 本当かどうかmacないので解らないのですが、^^; それと、100ファイル、操作 ← Winでも回答付きにくい傾向に(*'▽') あるかもしれません(T_T) ちなみに、番号の一意な一覧表[番号マスタ]なるものは有りますでしょうか。 あと VBAはHellowWorldをメッセージボックスで表示くらいなら、ご自分でおできに なるのでせうか。 m(_ _)m （隠居Z） 2021/09/13(月) 13:38 ---- Macで、フォルダ内のファイル一覧を取得する方法がわかりません。 GetOpenFilenameが使えるとよいのですが… 集計は「統合」機能を利用しています。 1）作業用フォルダを用意 2）その中に集計したいファイルを格納 3）下記のマクロを実行 4）ファイル選択ダイアログで、すべてのファイルを選択 5）マクロブックの1番目のシートに結果を表示します Sub test() Dim ff, fn Dim tbl As Range, adr As String, s Dim wb As Workbook ff = Application.GetOpenFilename(MultiSelect:=True) If Not IsArray(ff) Then Exit Sub For Each fn In ff With Workbooks.Open(fn).Sheets(1) Set tbl = .Cells(1).CurrentRegion adr = adr & " " & tbl.Address(, , xlR1C1, True) tbl.Columns(2).Replace "-", "" End With Next s = Split(WorksheetFunction.Trim(adr)) With ThisWorkbook.Sheets(1) .UsedRange.ClearContents .Cells(1).Consolidate s, xlSum, True, True .Cells(1).CurrentRegion.Resize(, 2).Consolidate s, xlCount, True, True .Cells(1).Value = "番号" End With For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then wb.Close False Next End Sub ↑ただ100ファイルを同時に開くのは無謀かもしれません。 1つずつ開いて、閉じてを繰り返し データを1つのシートに集約してから「統合」がよかったかも。 いずれにせよ、GetOpenFilenameでファイル一覧を取得できれば、 なんとかなると思います。 （マナ） 2021/09/13(月) 17:23 ---- Sub test2() Dim ff, fn Dim adr As String Dim wb As Workbook Dim ws As Worksheet ff = Application.GetOpenFilename(MultiSelect:=True) If Not IsArray(ff) Then Exit Sub Set ws = ThisWorkbook.Sheets(1) ws.UsedRange.ClearContents ws.Range("A1:C1").Value = Array("番号", "記号", "個数") For Each fn In ff Set wb = Workbooks.Open(fn) wb.Sheets(1).Range("A1").CurrentRegion.Offset(1).Copy _ ws.Range("A" & Rows.Count).End(xlUp).Offset(1) wb.Close False Next ws.Columns("B").Replace "-", "" adr = ws.Range("A1").CurrentRegion.Address(, , xlR1C1, True) ws.Range("E1").Consolidate adr, xlSum, True, True ws.Range("E1").CurrentRegion.Resize(, 2).Consolidate adr, xlCount, True, True ws.Range("E1").Value = "番号" ws.Columns("A:D").Delete End Sub （マナ） 2021/09/13(月) 17:54 ---- ＞ Array("番号", "記号", "個数") 個数でなく、点数でした。 （マナ） 2021/09/13(月) 17:59 ---- こんばんは ^^ EXCEL2019では Dir関数が改善され使えるとか。。。2021とのことなので 使えるかどうか、実験してもらうしかないような気が。 シェルからアップルスクリプト、なるものが使えるとか使えないとか^^; 私の場合、DIR関数が使えないと、ギブアップです。。。(T_T) (￣▽￣) 済みませんでした。 m(_ _)m （隠居Z） 2021/09/13(月) 19:41 ---- 隠居Z 様 こんばんは! こういった内容だと回答つきにく傾向にあるのですね。 ご回答いただいている皆様,ありがとうございます。 番号マスタのような一覧表はなく,A列は全ブック同じで,z001‾z125までの英数字が上から順に並んでいます。 VBAに関しては初心者ですが,メーセージボックスでHellow Worldを表示させることはできます。 自分のエクセルでもDir関数は使えました。 何かよい方法などあればご教示いただきたいです。 よろしくお願いします。 （とりにく） 2021/09/13(月) 20:09 ---- マナ 様 マクロを組んでいただきありがとうございます。 test2を試してみました。 ファイル選択画面は表示されるのですが,複数選択はできませんでした。 また,ファイルを1つだけ選択して開こうとしても開けませんでした。 Macの仕様のせいなのでしょうか。 申し訳がありませんが,他に対処法・やり方などありましたらご教示いただけますでしょうか。 よろしくお願いします。 （とりにく） 2021/09/13(月) 20:15 ---- MultiSelect:=True が無視されてしまうのであれば お手上げです。 （マナ） 2021/09/13(月) 21:19 ---- こんばんは ^^ ↓とりあえず、実験お願いいたします。まともに、テスト用ダミーブックが 作成、削除等、出来れば、なんとかなるかも。。。←多分ですが。。。^^; ハングアップのリスクを伴いますので、実験実行はアプリの強制終了のご準備 を整えてからにしてくださいませ。 新規作成の任意のフォルダに新規ブックでお試しを。m(_ _)m Sub zDummyBookMK() Dim fD As String Dim fNm As String Dim wB As Workbook Dim i As Long Dim cnt As Long Dim v() As Variant Dim w() Dim t As Double t = Timer ReDim v(1 To 150, 1 To 1) Rnd -5 fD = ThisWorkbook.Path & "/" fDelete Set wB = Workbooks.Add wB.SaveAs fD & "tmp.xlsx", 51 For i = 1 To 150 v(i, 1) = "z" & Format(i, "000") Next Do ReDim w(1 To 150, 1 To 3) For i = 1 To 150 w(i, 1) = v(i, 1) If i Mod Int((5 - 1 + 1) * Rnd + 1) = 0 Then w(i, 2) = ChrW(9675) End If w(i, 3) = Int((5 - 1 + 1) * Rnd + 1) Next With wB.Worksheets(1) .UsedRange.Clear .Cells(1).Resize(, 3) = Array("番号", "記号", "点数") .Cells(2, 1).Resize(UBound(w, 1), UBound(w, 2)) = w End With wB.SaveCopyAs fD & "test" & Format(cnt, "000") & ".xlsx" cnt = cnt + 1 If cnt Mod 16 = 0 Then DoEvents If cnt >= 3 Then Exit Do Loop wB.Close False If Dir(fD & "tmp.xlsx") <> "" Then Kill fD & "tmp.xlsx" End If Erase v, w MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _ Format((Timer - t) - Int(Timer - t), ".000") & " 秒" End Sub Private Sub fDelete() Dim fNm As String Dim fD As String fD = ThisWorkbook.Path & "/" fNm = Dir(fD & "*.xlsx") Do Until fNm = "" Kill fD & fNm fNm = Dir() Loop End Sub （隠居Z） 2021/09/13(月) 21:51 ---- 追伸 ^^; マクロの有るブック .xlsm 無いブック .xlsx ファイルの拡張子が違う場合は、実験を取り止め お知らせください。 （隠居Z） 2021/09/13(月) 21:56 ---- マナ さん のtest2実行して見ました 3ファイル位だと瞬間でした。。。(*'▽') w、統合も勉強してみます。m(_ _)m （隠居Z） 2021/09/13(月) 22:08 ---- マナ 様 同僚のWindowsを借りてtest2を実行したところ,瞬時にやりたかったことが完結しました。 調べたところ,MacではGetOpenFilenameは使えるもののMultiSelectは使えないようです。 Macの弊害が・・・ 同僚のWindowsを使わせてもらえる時はこの方法を実行してみます。 大変ありがとうございました。 （とりにく） 2021/09/14(火) 00:32 ---- 隠居Z 様 何度もありがとうございます! マナ様のtest2でwindowsでは実行できたのですが,自分はMacしかもっていないので,どうにかMacでもできるようになればいいなと思っています。 隠居Z様のものを試すと,「実行時エラー'75' パス名/ファイル名が無効です。」と表示されました。 デバッグすると,Private Sub の Kill fD & fNm がハイライト表示されています。 ちなみに,マクロの有るブック（.xlsm）と無いブック（.xlsx）は括弧内のように拡張子が異なります。 自分でも Do と Loop でできないか試みましたが,やはり素人のためうまくできませんでした。 何か良い方法がありましたらご教示のほどお願いいたします。 （とりにく） 2021/09/14(火) 00:42 ---- おはようございます ^^ fD = ThisWorkbook.Path & "/" を ↓ fD = ThisWorkbook.Path & Application.PathSeparator に、変えてみて下さい。 今日は今から、外出です。夕刻には帰りますが ↑で動けば、他の方から、アドバイスが有るかもしれません。 多分動くと思います。。。^^;。。。多分。(￣▽￣) m(_ _)m （隠居Z） 2021/09/14(火) 07:25 ---- 隠居Z 様 おはようございます。 変更してみましたが,「実行時エラー'75'」が出てしまいます。 自分で簡単なマクロを組み,同一フォルダ内にマクロブック(.xlsm)と集計元ブックの簡易版(.xlsx)を置いて実行した際には, ThisWorkbook.Path & "/" を使っていても動作しました。何か他に原因があるのでしょうか? 質問ばかりですみませんが,ご教示のほどよろしくお願いいたします。 （とりにく） 2021/09/14(火) 10:25 ---- こんばんわ。。。^^; やはり、だめでしたか。。。 Msgbox fNm で、中身を見ていただけますでしょうか。 fDも見て頂いて、合っているかご確認を。 空が返ると、何もせず終了するはずなので。何か返っている気がするのですが フォルダ名、ファイル名、ともに、差支えなければ、教えて頂けますでしょうか。 不都合があれば結構ですが。命名規則に抵触していないか[使えない文字^^;]等 お調べを。。。m(_ _)m dirがやはり不測の事態に有るのでしたら。LS とか、調べてはみますが 私が解るかどうかは解りません。 さらに、お詳しい方のアドバイスを、引き続きお待ちくださいませ。 （隠居Z） 2021/09/14(火) 17:15 ---- 隠居Z 様 こんばんは。 ありがとうございます。 確認して以下が返されます。 fD:/Users/usersname/Desktop/集計test1/ fNm:book1.xlsx 試しに, fD = ThisWorkbook.Path & Application.PathSeparator を fD = "/Users/usersname/Desktop/集計test1/" に変更して実行したところ,なぜかこれまでのエラーは表示されなくなりましたが, 「実行時エラー ‘1004':' tmp.xlsx' への変更は,共有違反のため保存されませんでした。別のファイルに保存し直して下さい。」 が表示されるようになりました。 これが解決できませんでした。 他にご有識者の方がおられましたら,ご教示のほどよろしくお願いいたします。 （とりにく） 2021/09/15(水) 02:51 ---- おはようございます ^^ Dir関数ですが、2019以降は使えるみたいですが、新規のフォルダでは先立って アクセス権の設定が必要みたいです。↑はブックの共有で読み取り専用になっているか 若しくは何らかの理由でパーミッションが書込み禁止になっていることが原因の場合が 多いようです。後ろの、51消して見るのも一案ですが、多分関係無いかと。^^; 何れにしましても、私のコードはDir及びファイルの読み書き削除テストみたいなもの なので、動かずとも、とりにく さんの目的とはあまり関係は。。。ま、テストデーター なので無関係とは言いませんが有っても無くても。。。m(__)m Dirが動くなら、それでファイル一覧を作成され、マナさんのご提示のコードで目的は 達成されるのではないでしょうか。 読込だけで、保存は無かったように。。。← 多分^^; でわでわ。また、m(_ _)m （隠居Z） 2021/09/15(水) 08:33 ---- 追伸 最後の頼みの綱、 myPath = MacScript("ChooseFile") MacScriptも廃止されているそぉで。。。mmm お役に立てず、済みませんでした。 わたしは、ここまでとさせて戴きます。m(__)m 撤収〜〜〜(T_T) m(__)mm(__)mm(__)m （隠居Z） 2021/09/15(水) 10:53 ---- 隠居Z 様 色々とご検討くださりありがとうございました。 アクセス権は付与しているのですが,ウィルス対策ソフトの問題かもしれません（ファイル監視停止してもうまくいきませんでしたが）。 自分でも検討してみます。 大変お世話になりました。ありがとうございました。 他にご有識者の方がおられましたら,ご教示のほどよろしくお願いいたします。 （とりにく） 2021/09/15(水) 15:48 ---- DirがWindowsと同じように使えるなら Sub test3() Dim ws As Worksheet Dim p As String, fn As String Dim wb As Workbook Dim adr As String Set ws = ThisWorkbook.Sheets(1) ws.UsedRange.ClearContents ws.Range("A1:C1").Value = Array("番号", "記号", "個数") p = ThisWorkbook.Path & "¥" '★ fn = Dir(p & "*.xlsx") Do While fn <> "" Set wb = Workbooks.Open(fn, ReadOnly:=True) wb.Sheets(1).Range("A1").CurrentRegion.Offset(1).Copy _ ws.Range("A" & Rows.Count).End(xlUp).Offset(1) wb.Close False fn = Dir() Loop ws.Columns("B").Replace "-", "" adr = ws.Range("A1").CurrentRegion.Address(, , xlR1C1, True) ws.Range("E1").Consolidate adr, xlSum, True, True ws.Range("E1").CurrentRegion.Resize(, 2).Consolidate adr, xlCount, True, True ws.Range("E1").Value = "番号" ws.Columns("A:D").Delete End Sub （マナ） 2021/09/15(水) 17:14 ---- 修正 ＞Set wb = Workbooks.Open(fn, ReadOnly:=True) ↓ Set wb = Workbooks.Open(p & fn, ReadOnly:=True) （マナ） 2021/09/15(水) 17:16 ---- マナ 様 ありがとうございます!やりたいことが実行できました!! Macの仕様か,初めてアクセスする全てのフォルダ・ファイルにアクセス権を付与するウィンドウが立ち上がり,全てに許可を出すのは手間ですが。 大変お世話になりました。改めて御礼申し上げます。 （とりにく） 2021/09/16(木) 01:29... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202109/20210912021517.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608126 words.
訪問者：