Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)
vba (14736), 強制終了 (237)
- [[20170325215116]]
- #score: 16175
- @digest: df52d6035a44936d430b35970557907e
- @id: 73042
- @mdate: 2017-03-29T20:28:21Z
- @size: 15908
- @type: text/plain
- #keywords: 月山 (28795), 右近 (23822), 木次 (23560), 力側 (20447), 子4 (19609), 田花 (17571), 本太 (16628), 郎4 (13934), 近） (11786), 表1 (10475), 2800 (9484), 3500 (8301), 花子 (8221), 表2 (7896), ・表 (6926), 次郎 (6279), （右 (5695), arraylist (5243), collections (5058), 山本 (5038), 山田 (5033), 2017 (4072), 列? (3947), 鈴木 (3037), dic (2949), 番号 (2209), usedrange (2180), error (1889), createobject (1880), 日付 (1873), 次第 (1672), の4 (1659)
- 『年間の集計を横並びに作成する』（右近）
おたずねいたします。 以下のような表1があります。 4月から3月までの名簿がありまして、各月の名簿は基本的に重複していますが、途中の月から新規で追加される名前があります。 人によって、各月1データの場合もありますし、2とか3データの場合もあり、まちまちです。 以下の表では各月の行数は一定にはなっていませんが、実際には一定の行数です。 表1 __A____B__________C______D____E______F____G____H____I 1 4月 山田花子 4/20 3500 2 4月 鈴木次郎 4/23 3800 4/30 2500 3 4月 山本太郎 4/30 3200 ・ ・ ・ 25 5月 山田花子 5/ 6 2800 26 5月 鈴木次郎 5/10 3000 27 5月 山本太郎 5/20 2900 ・ ・ ・ 7012月 上記表1をもとに以下の表2のように名前別に年間の集計をさせたいのです。 横に配列させたいのです。 もちろん、 表2 __F____ G____ H_____I______J______K______L 1 山田花子 4/20 3500 5/ 6 2800 2 鈴木次郎 4/23 3800 4/30 2500 5/10 3000 3 山本太郎 4/30 3200 5/20 2900 ・ ・ ・ OFFSET関数でやってみましたが、これでは縦にデータがつみあがってしまい、表2のように横に並べていく方法がわかりません。 お力添えのほど、よろしくお願いします。 ＜ 使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- こう云うのはマクロが適しているんですけど、関数じゃないとダメなんですか? （半平太） 2017/03/26(日) 18:58 ---- 各表の各項目が、どの列なのかちょっとわかりにくいですね。 ・表1 の 1 4月 山田花子 4/20 3500 これらはどの列ですか? 4月は A列? B列? ・表1 の 4/20 3500 といったデータは、いくつはいるか限定されていますか? それとも、いくつあるかは、そのデータ次第ですか? ・表2 についても、各列が具体的にどこなのかがわかりにくいです。 1 山田花子 4/20 3500 5/ 6 2800 の各項目は、それぞれどの列ですか? ・表1 に対する回答次第なんですが、表1 の 4/20 3500 といったデータの個数によっては表1 の最終列がどこかは わからないわけですよね? であれば、表2 を特定の決められた列から表示するというのは、ちょっとしんどいですね? ここは、どう考えていますか? （ β） 2017/03/26(日) 22:04 ---- ご返事いただきありがとうございます。 一つ修正させてください。 日付と番号のセットということにしていますが、日付の入力を省略するために、一ヶ月のカレンダー上の日付のセルに番号のみを入力するという形にした方が入力も容易かと思っております。 なので、C列が1日、D列が2日、E列が3日・・・という具合にして、その該当セルに番号のみを入力する。 表2にその番号を入力した日と番号を横並びにさせるという形にしたいと考えます。 色々試行錯誤している中で、カレンダー上に番号のみを入力の方がスマートだと思い、このように修正させて頂ければと思います。 βさんからご質問いただいた回答は以下のとおりですが、あくまでこの回答はこの修正前のものということになります。 どうぞよろしくお願いいたします。 ・表1 の 1 4月 山田花子 4/20 3500 これらはどの列ですか? 4月は A列? B列? →回答）4月はA列、名前はB列、日付はC列、番号はD列です。 ・表1 の 4/20 3500 といったデータは、いくつはいるか限定されていますか? それとも、いくつあるかは、そのデータ次第ですか? →回答）名前によって様々です。極端に言うと、月に1回の人もあれば、5回の人もいるという感じです。 ・表2 についても、各列が具体的にどこなのかがわかりにくいです。 1 山田花子 4/20 3500 5/ 6 2800 の各項目は、それぞれどの列ですか? →回答）名前はF列、日付はG列、番号はH列・・・・・ ・表1 に対する回答次第なんですが、表1 の 4/20 3500 といったデータの個数によっては表1 の最終列がどこかはわからないわけですよね? →回答）はい。ただ、日付と番号の組合せが6セットあれば足りると考えています。 ・であれば、表2 を特定の決められた列から表示するというのは、ちょっとしんどいですね? ここは、どう考えていますか? →回答）G列からいければと考えていますが・・・ （右近） 2017/03/27(月) 07:31 ---- >G列からいければと考えていますが・・・ もし、表1 と 表 2 を同じシートに配置すると考えておられるとすれば >日付と番号の組合せが6セットあれば足りると考えています 6セットあった場合は、表1 のデータは、N列まであることになりますね。 そこに G列から 表2 を配置すると、表1 の一部が 上書きされてしまいますが? （ β） 2017/03/27(月) 07:38 ---- 表1のイメーはこのような形です。 これをもとに表に日付と番号を横並びにもっていければと思います。 A B C D E F G ・・・ V W X Y 1 1 2 3 4 5 ・・・ 20 21 22 23 2 4月 山田花子 3500 3 4月 鈴木次郎 3800 （右近） 2017/03/27(月) 07:41 ---- 申し訳ありません。 そうですね。同一シートに表2を作成する前提ですと、 日付が1〜31日までがC列からAG列まで必要ですので、表2はそれ以降のAH列以降ということになります。 よろしくお願いします。 （右近） 2017/03/27(月) 07:44 ---- 関数処理がご希望のようですから、それは専門家さんにお任せするとして、場つなぎでVBAです。 なお、A列が文字列としての 4月 等のようで、年が気になりますので、展開後の 4/20 等も文字列にしています。 ★実際にテストデータを作ってみましたが、このレイアウトも、入力しにくいですねぇ。 （入力のしやすさからいえば、元々のもののほうが、操作者にとって簡単かも） Sub Samle() Dim c As Range Dim r As Range Dim d As Range Dim dic As Object Dim k As Variant Dim x As Long Dim w As Variant Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") For Each c In Range("B2", Range("B" & Rows.Count).End(xlUp)) If Not dic.exists(c.Value) Then Set dic(c.Value) = CreateObject("System.Collections.ArrayList") Set r = Nothing On Error Resume Next Set r = c.Offset(, 1).Resize(, 31).SpecialCells(xlCellTypeConstants, xlNumbers) On Error GoTo 0 If Not r Is Nothing Then For Each d In r dic(c.Value).Add "'" & Replace(d.EntireRow.Cells(1).Value, "月", "") & "/" & d.EntireColumn.Cells(1).Value dic(c.Value).Add d.Value Next End If Next ActiveSheet.UsedRange.Offset(1, 33).ClearContents Range("AH2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys) x = 2 For Each k In dic w = dic(k).toarray Cells(x, "AI").Resize(, UBound(w) + 1).Value = w x = x + 1 Next End Sub （ β） 2017/03/27(月) 09:13 ---- βさん、ご指導ありがとうございます。 テストデータを導入する前に再度、このデータの入るシートの確認、修正を行っています。 先にお伝えしたデータの入る列がずれてしまいました。実際には、 AK列〜BD列の4行目以降にデータが入ります。その詳細は以下のとおりです。 ___C_________AK______AL______AM______AN・・・・BC______BD 3 名前 日付1 番号1 日付2 番号2 日付10 番号10 4 山田 4/ 1 2800 4/15 3200 5 鈴木 4/ 5 2900 4/20 2700 ・ ・ ・ 20 山田 5/ 6 3000 5/29 2500 ・ ・ ・ 上記を同一シートのDW列の4行以降に以下のように並び替えさせられたらと思います。 例えば、山田さんの4月から3月までのデータを一つの行に集約したいのです。 __DW_________DX______DY______DZ______EA________EB_______EC_______ED・・・・・ 日付1 番号1 日付2 番号2 日付3 番号3 日付4 番号4 4 4/ 1 2800 4/15 3200 5/ 6 3000 5/29 2500 ___ （右近） 2017/03/28(火) 12:52 ---- おはようございます。 βさんのVBAを導入してみました。 ところが、読込みのマークが長時間出てしまい、最終的には強制終了する形になってしまいます。 今一度お尋ねですが、これを関数で導くことは可能でしょうか? （右近） 2017/03/29(水) 07:32 ---- >読込みのマークが長時間出てしまい、 こちらで想定したレイアウトや、その中の値が実際のものと異なるんでしょうね。 いずれにしても、βは関数超苦手ですので、専門家さんの回答をお待ちください。 （β） 2017/03/29(水) 08:24 ---- ＞今一度お尋ねですが、これを関数で導くことは可能でしょうか? 当初のレスで書きましたが、関数での処理には向いていません。 一つのセルに結果を出すのに、膨大な範囲を何度も見に行かなければならないからです。 やってやれないこともないと言う代物です。私は、やる気が起きません。 ※マクロ使用が職場で禁止されていると言う様な事情があれば別です。 そう書けば、関数専門家さんからレスが付くと思います。 最終的なレイアウトが下図の通りだとした場合、お節介ながら それに合わせて βさんのプログラム を修正すれば後記の通りです。 TO:βさん 大変勉強になりました。m(__)m <サンプルおよび結果図> 行 ____C____ _D_ _AJ_ ___AK___ _AL_ ___AM___ _AN_ __AO__ _AP_ ___DW___ ____DX____ _DY_ ____DZ____ _EA_ ____EB____ _EC_ ___ED___ _EE_ ___EF___ _EG_ 3 名前 日付 4 山田花子 4月20日 3500 山田花子 2017/4/20 3500 2017/5/6 2800 5 鈴木次郎 4月23日 3800 4月30日 2500 鈴木次郎 2017/4/23 3800 2017/4/30 2500 2017/5/10 3000 2017/5/1 2501 2017/5/2 2502 6 山本太郎 4月30日 3200 山本太郎 2017/4/30 3200 2017/5/20 2900 7 吉田拓郎 2017/6/1 7777 8 9 10 山田花子 5月6日 2800 11 鈴木次郎 5月10日 3000 5月1日 2501 5月2日 2502 12 山本太郎 5月20日 2900 13 14 吉田拓郎 6月1日 7777 Sub Samle() 'βさんのプログラムがベース Dim c As Range Dim r As Range Dim d As Range Dim dic As Object Dim k As Variant Dim x As Long Dim w As Variant Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") For Each c In Range("C4", Range("C" & Rows.Count).End(xlUp)) If Not IsEmpty(c.Value) Then If Not dic.exists(c.Value) Then Set dic(c.Value) = CreateObject("System.Collections.ArrayList") End If End If Set r = Nothing On Error Resume Next Set r = Cells(c.Row, "AK").Resize(, 20).SpecialCells(xlCellTypeConstants, xlNumbers) On Error GoTo 0 If Not r Is Nothing Then For Each d In r dic(c.Value).Add d.Value Next End If Next Intersect(ActiveSheet.UsedRange.Rows, Columns("DW:LN")).ClearContents Range("DW4").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys) x = 4 For Each k In dic w = dic(k).toarray Cells(x, "DX").Resize(, UBound(w) + 1).Value = w x = x + 1 Next End Sub （半平太） 2017/03/29(水) 11:27 ---- 半平太さん、ありがとうございます。 実行しようとすると、以下のメッセージが表示されました。 オブジェクト変数またはWithブロック変数が設定されていません。 （右近） 2017/03/29(水) 16:54 ---- 済みません。エラーの原因になりそうな部分を幾つか修正しました。 Sub Samle() 'βさんのプログラムがベース Dim c As Range Dim r As Range Dim d As Range Dim dic As Object Dim k As Variant Dim x As Long Dim w As Variant Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") For Each c In Range("C4", Range("C" & Rows.Count).End(xlUp)) If Not IsEmpty(c.Value) Then If Not dic.exists(c.Value) Then Set dic(c.Value) = CreateObject("System.Collections.ArrayList") dic(c.Value).Add c.Value End If Set r = Nothing On Error Resume Next Set r = Cells(c.Row, "AK").Resize(, 20).SpecialCells(xlCellTypeConstants) On Error GoTo 0 If Not r Is Nothing Then For Each d In r dic(c.Value).Add d.Value Next End If End If Next On Error Resume Next Intersect(ActiveSheet.UsedRange.Rows, Columns("DW:LN")).ClearContents On Error GoTo 0 x = 4 For Each k In dic w = dic(k).toarray Cells(x, "DW").Resize(, UBound(w) + 1).Value = w x = x + 1 Next End Sub （半平太） 2017/03/29(水) 22:04 ---- 半平太さん、すごいです!! 思いどおりの結果となりました。 改めてここにいる方々は、すごい知識をお持ちの方々なんですね。 半平太さん、この抽出形式について、もう一つお尋ねしてもよいでしょうか? 今回の場合は、1行に日付と番号という形ですが、例えば、2行にして上が日付、下が番号という形にすることも可能なのでしょうか? その場合は、 Intersect(ActiveSheet.UsedRange.Rows, Columns("DW:LN")).ClearContents この部分の修正となるのでしょうか? ご教授願います。 （右近） 2017/03/29(水) 22:37 ---- ＞Intersect(ActiveSheet.UsedRange.Rows, Columns("DW:LN")).ClearContents それは、打ち出しエリアを更地にするステートメントです。 何度も実行することを考えると、前回の結果が残っており、且つ前回のデータの方が多いと、 新しい結果を貼り付けても、前回の一部が残って見えるので、前回分を完全に消去する必要があります。 ＞今回の場合は、1行に日付と番号という形ですが、 ＞例えば、2行にして上が日付、下が番号という形にすることも可能なのでしょうか? 当然、可能ですけど、入力側の話ですか、出力側の話ですか、それとも両方ですか? （半平太） 2017/03/29(水) 22:50 ---- いいえ、入力側はそのままで、出力側です。 （右近） 2017/03/29(水) 22:53 ---- 出力側は2段ベース Sub Samle() 'βさんのプログラムがベース Dim c As Range Dim r As Range Dim d As Range Dim dic As Object Dim k As Variant Dim x As Long Dim w As Variant Dim Col As Long Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") For Each c In Range("C4", Range("C" & Rows.Count).End(xlUp)) If Not IsEmpty(c.Value) Then If Not dic.exists(c.Value) Then Set dic(c.Value) = CreateObject("System.Collections.ArrayList") dic(c.Value).Add c.Value End If Set r = Nothing On Error Resume Next Set r = Cells(c.Row, "AK").Resize(, 20).SpecialCells(xlCellTypeConstants) On Error GoTo 0 If Not r Is Nothing Then For Each d In r dic(c.Value).Add d.Value Next End If End If Next On Error Resume Next Intersect(ActiveSheet.UsedRange.Rows, Columns("DW:LN")).ClearContents On Error GoTo 0 x = 4 For Each k In dic w = dic(k).toarray Col = 0 For Col = 0 To UBound(w) Step 2 If Col = 0 Then Cells(x, "DW").Value = w(Col) Else Cells(x, "DW").Offset(, Col / 2).Value = w(Col - 1) Cells(x, "DW").Offset(1, Col / 2).Value = w(Col) End If Next Col x = x + 2 Next End Sub '※ 出力エリアのセルの書式は適切に設定してください。 （半平太） 2017/03/29(水) 23:21 ---- おはようございます。 半平太さん、ありがとうございます。 素晴らしいです! まさに思うとおりの結果が得られました。 （右近） 2017/03/30(木) 05:28... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201703/20170325215116.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97057 documents and 608292 words.
訪問者：