エクセルの学校：全文検索：Hyper Estraier： VBA 強制終了

Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)

vba (14739), 強制終了 (237)

[[20160104150938]]: #score: 16175; @digest: fa906d5c405966aa9618f9cc7a968b0a; @id: 69617; @mdate: 2016-01-05T00:56:10Z; @size: 7286; @type: text/plain; #keywords: 滴0 (46493), 床96 (45725), 目44 (33166), 点滴 (29801), 112a (21804), 44b (15497), 転◎ (15497), ・mb (15497), 血55 (15497), 転× (15241), 再採 (14761), 続▼ (14647), 採血 (13718), カフ (12240), ・er (10634), ェ） (9626), mh (8898), columns (5157), 万行 (3922), column (3835), ・転 (3782), フェ (3276), は- (3008), 現行 (2540), 制終 (2409), ・・ (1898), 列〜 (1536), 強制 (1194), rows (1138), ー時 (1123), value (1091), ・2 (1030); 『データの移動』（カフェ）
お世話になります。下のような1行で横に長いデータが、1万行近くあります。これを、規則に沿って縦にしたいです。 1行目は項目です。A列〜EQ列は基本データです。 ER列〜MA列は、横長で3セルがひとつづりになっています。（ER〜ET,EU〜EW,EX〜EZ・・・）データが入ってないセルも多々あります。 3セルの中で1セルでもデータが入っていれば、これを、ER列〜ET列に、縦に移動したいのです。 A列〜EQ列までは、同じデータをコピーします。しかし、MB列〜MH列のどこかにデータがあるときだけは、一番最後の行に、A列〜EQ列プラス MB列〜MH列となるようにします。 VBA初期の私には、大変難しく、時間がたつばかりです。よろしくお願いいたします。 A B C D E ・・・ 2行目 44B 点滴0 は-112A 床96 ・・・ ER ES ET EU EV EW EX EY EZ FA FB FC ・・・ 2行目転 ◎ 30 転 × 続 ▼ 63 ○ ・・・ MB MC MD ME MF MG MH 2行目再採血 55B keep 1 現行・・・・・・ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - - - - - - - - - - - - - ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ A B C D E ・・・ ER ES ET EU EV EW ・・・・MB MC MD ME MF MG MH 2行目 44B 点滴0 は-112A 床96 ・・・転 ◎ 30 3行目 44B 点滴0 は-112A 床96 ・・・転 × 4行目 44B 点滴0 は-112A 床96 ・・・続 ▼ 63 5行目 44B 点滴0 は-112A 床96 ・・・ ○ ・・・・・・ A B C D E ・・・ER ES ET EU EV EW ・・・・MB MC MD ME MF MG MH 最後の行 44B 点滴0 は-112A 床96 再採血 55B keep 1 現行＜使用 Excel:Excel2007、使用 OS:Windows7 ＞ ---- コードを書きなぐっただけで検証していませんので不具合、あるいは勘違いあれば指摘願います。もう少し、すっきりさせることも、できるかもしれませんが、とりあえず。なお、オリジナルシートを組み変えて上書きするのではなく、別シートに展開。（以下コードでは Sheet1 ---> Sheet2） Sub Test1() Dim c As Range Dim w As Variant Dim mx As Long Dim x As Long Dim i As Long Dim j As Long Dim hd As Variant Dim n As Long Application.ScreenUpdating = False With Sheets("Sheet1") '元シート mx = .UsedRange.Rows.Count hd = .UsedRange.Rows(1).Value 'タイトル行 ReDim w(1 To mx * 65, 1 To Columns("MH").Column) For i = 2 To mx For j = Columns("ER").Column To Columns("MA").Column Step 3 If WorksheetFunction.CountA(.Cells(i, j).Resize(, 3)) > 0 Then x = x + 1 For n = 1 To Columns("EQ").Column w(x, n) = .Cells(i, n).Value Next w(x, Columns("ER").Column) = .Cells(i, j).Value w(x, Columns("ES").Column) = .Cells(i, j + 1).Value w(x, Columns("ET").Column) = .Cells(i, j + 2).Value End If Next If WorksheetFunction.CountA(.Range(.Cells(i, "MB"), .Cells(i, "MH"))) > 0 Then x = x + 1 For n = 1 To Columns("EQ").Column w(x, n) = .Cells(i, n).Value Next w(x, Columns("MB").Column) = .Rows(i).Range("MB1").Value w(x, Columns("MC").Column) = .Rows(i).Range("MC1").Value w(x, Columns("MD").Column) = .Rows(i).Range("MD1").Value w(x, Columns("ME").Column) = .Rows(i).Range("ME1").Value w(x, Columns("MF").Column) = .Rows(i).Range("MF1").Value w(x, Columns("MG").Column) = .Rows(i).Range("MG1").Value w(x, Columns("MH").Column) = .Rows(i).Range("MH1").Value End If Next End With With Sheets("Sheet2") .Cells.ClearContents .Range("A1").Resize(, UBound(hd, 2)).Value = hd .Range("A2").Resize(x, UBound(w, 2)).Value = w .Select End With End Sub （β） 2016/01/04(月) 17:34 ---- （β）さん、ありがとうございます。さきほど、1回だけできました! 思い通りのデータ移動でした。でも、2回目から、何度やっても強制終了になります。これで5回目です。 MB列からの For n = 1 To Columns("EQ").Column w(x, n) = .Cells(i, n).Value Next ここで、問題が起こりましたので、強制終了します・・・のようなメッセージがでて、勝手にエクセルが閉じられます。（カフェ） 2016/01/04(月) 18:53 ---- 1回、2回、・・・・というのは、同じデータで繰り返し処理を行ったということですね。コード、アップ後、こそっと? 直しているところがあります。 ReDim w(1 To mx * 65, 1 To Columns("MH").Column) ここですけど、この形で実行してもらっていますね。う〜ん・・・何でしょうかねぇ。そもそもが、1万行、データがきっしり入っていれば、65万行のデータになるわけでこれはこれで、ちょっと、空恐ろしい（?）ボリュームなんですが、メモリー関連でしょうか・・・エラー時の実際のデータは何行で、各行、3セルずつの組が、だいたいどれぐらいでしょうか? （β） 2016/01/04(月) 19:04 ---- （β）さんサンプルで 16行ほどです。一行づつ、ステップインしているところですが、先ほどと違って、すんなり移動できています。会社のデータは、1万行、きっしり入っていることはありません。頭を整理して、 w(x, Columns("ER").Column) = .Cells(i, j).Value w(x, Columns("ES").Column) = .Cells(i, j + 1).Value w(x, Columns("ET").Column) = .Cells(i, j + 2).Value この部分や、 w(x, Columns("MB").Column) = .Rows(i).Range("MB1").Value w(x, Columns("MC").Column) = .Rows(i).Range("MC1").Value w(x, Columns("MD").Column) = .Rows(i).Range("MD1").Value w(x, Columns("ME").Column) = .Rows(i).Range("ME1").Value w(x, Columns("MF").Column) = .Rows(i).Range("MF1").Value w(x, Columns("MG").Column) = .Rows(i).Range("MG1").Value w(x, Columns("MH").Column) = .Rows(i).Range("MH1").Value この部分を勉強したいと思います。（カフェ） 2016/01/04(月) 23:47 ---- （β）さん昨日は、ありがとうございました! サンプル1万行で試してみました。問題なく、早くできました。また、今のところ、何回試しても、止まることはありません。 ReDim w(1 To mx * 65, 1 To Columns("MH").Column) ヘルプで見てみると、”動的配列変数の記憶域の容量を再度割り当てます。”と書いてありました。このコードからいろいろと調べることができて、大変勉強になりました。（β）さん、本当にありがとうございました。また、よろしくお願いいたします。（カフェ） 2016/01/05(火) 09:56 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/201601/20160104150938.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ