Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)
vba (14726), 強制終了 (237)
- [[20160723235008]]
- #score: 16176
- @digest: ea03946e04dd09da724be01939ec4899
- @id: 71227
- @mdate: 2016-08-01T11:41:14Z
- @size: 28550
- @type: text/plain
- #keywords: 店, (35981), 、") (17916), rowno (15584), 万行 (7067), ubound (6027), 行挿 (5520), 展開 (5222), 2016 (5081), メロ (4570), insert (3916), temp (3859), 挿入 (3609), substitute (3433), 配列 (3281), 日) (3081), split (3041), 行数 (2988), ロン (2681), 格納 (2676), buf (2589), 処理 (2383), （β (2358), resize (2243), len (2218), 列数 (2169), currentregion (2104), コー (2103), 元デ (1876), 変数 (1725), variant (1667), マナ (1666), 、文 (1656)
- 『読点の数だけ、下に行を追加する』（aki）
こんばんわ よろしくお願いします。 以下のような表があります。 _____[A]_____ _____[B]_____ [1] [2] A店 りんご、バナナ [3] B店 もも [4] C店 メロン、イチゴ、サクランボ [5] D店 なし、レモン [6] E店 すいか [7] [8] [9] [10] A店 りんご、バナナ [11] [12] B店 もも [13] C店 メロン、イチゴ、サクランボ [14] [15] [16] D店 なし、レモン [17] [18] E店 すいか A2、B2にデータが入っており、B列に含まれる、読点の数だけ下に行を 挿入したいのですが、このようなことは可能なんでしょうか。 例えば、A2には、1つなので1行、B4には2つなので、2行 結果として、A10以降のような形にしたいのです。 宜しくお願いします。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- VBAなら可能でしょうね。工程として、 1.文字列から「、」の数を調べる処理 2.上で得た数値分だけ、行を挿入する処理 3.それをデータの列数分だけ行うループ処理 これらを1つずつ調べていけば出来ますよ。 難易度的には難しいものではなく、どれも検索すれば出てくるものなので これを機に慣れてみると良いと思います。 （むーたん） 2016/07/24(日) 01:29 ---- ＞このようなことは可能なんでしょうか。 もちろん可能。 すでに指摘されたとおりです。 追加のヒント。 上から下に実行していくと、 挿入された行によって未処理の行数が変わってしまって面倒。 こうした場合は、下から上に実行するとまぎれがありません。 ・6行目を判定。挿入不要。 ・5行目を判定。ひとつあるので、(5+1)行目に1行挿入。 ・4行目を判定。ふたつあるので、(4+1)行目に2行挿入。 こんな要領です。 "、"の数のカウントは、例えば、Len(s) - Len(Replace(s,"、","")) 挿入のコードは、マクロ記録をとるとよいかもしれない。 ご自分で少しトライして、できるところまで示して、 また意見を聞いてみるようにしたらよいでしょう。 （γ） 2016/07/24(日) 07:15 ---- 作業列、使いまくりで、かつ、表示は F列、E列 になりますが。 C2 : 2 、 D2 : 2 C3 : =LEN(B3)-LEN(SUBSTITUTE(B3,"、",""))+1 D3 : =C2+D2 C3:D3を下にフィルコピー E2 : =IFERROR(INDEX(A:A,MATCH(ROW(),$D:$D,0)),"") これをF2にフィルコピーし、そのまま下にフィルコピー。 不得意な数式処理なので、どこかに抜けもあるかもしれませんが。 （β） 2016/07/24(日) 07:46 ---- おはようございます。みなさまご教授有難うございます。 只今、出張中のため、帰宅後、勉強させていただきます。 有難うございます。 （aki） 2016/07/26(火) 07:32 ---- こんばんわ 色々ご教示ありがとうございました。 結果としては、全てマクロでできませんでしたが、 C列に=LEN(B2)-LEN(SUBSTITUTE(B2,"、",""))+1 を入力し Sub 行挿入() For i = Range("C" & Rows.Count).End(xlUp).Row To 1 Step -1 temp = Fix(Val(Cells(i, "C").Value)) If temp > 0 Then Rows(i + 1).Resize(temp).Insert Next End Sub の組み合わせで何とかなりました。 しかしながら、数式をその都度計算しているので、時間はかかってしまいます、、、 もう少し頑張ります。ありがとうございます。 （aki） 2016/07/27(水) 03:24 ---- すでに完成されていると思います。素晴らしい。 なお、下記のようにすると、作業列をつかわずに済みますね。 参考まで。 Sub 行挿入() Dim i As Long Dim s As String Dim temp As Long For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 s = Cells(i, 2).Value temp = Len(s) - Len(Replace(s, "、", "")) 'temp = Fix(Val(Cells(i, "C").Value)) If temp > 0 Then Rows(i + 1).Resize(temp).Insert Next End Sub 挿入処理は結構コストのかかる処理ですので、 データが大量にあると、ある程度時間はかかるものとお考え下さい。 （γ） 2016/07/27(水) 05:00 ---- γさん同様、感服です。 マクロ内でFor/Nextループに入る前に Application.ScreenUpdating = False これを記述しておくと、処理時間は若干、短縮化されると思います。 追記）今回は、γさんのコメントにあるように作業列をなくし、マクロ内で カンマ数を取得することで不要になりますが シート上に数多くの計算式がある場合、その参照セルの変更のつど、再計算が行われます。 計算式の数によっては、これも処理の足を引っ張る要因になります。 なので、ループに入る前、マクロの最初に Application.Calculation = xlCalculationManual これを記述して 再計算を抑止します。 で、この設定は Application.ScreenUpdating とは異なり、マクロが終了しても 残りっぱなしになりますので、End Sub の前に、忘れずに Application.Calculation = xlCalculationAutomatic を記述してください。 なお、Application.ScreenUpdating についても、そのタイミングで Application.ScreenUpdating = True と記述しておくほうが、わかりやすいですし お行儀の良いコードになりますね。 （β） 2016/07/27(水) 05:08 ---- おはようございます。 再計算で時間がかかると言うのは、実際のデータは何万行くらいあるんでしょうか? Insert はセルを直接操作するので、データ数が非常に多いと処理時間はどうしてもかかってしまいます。 そう言う場合は配列を使用すれば、劇的に処理時間が短縮されます。 ただ配列内での処理はそれなりに難しいのと、せっかくご自身で作ったコードと全然違う物になってしまうので、 まずはγさんやβさんのアドバイスを試してみて使えるなら、その方が良いと思います。 それでもどうしても遅くてきついと言う事でしたら、配列での方法も提示します。 （sy） 2016/07/27(水) 07:06 ---- A B C D E 1 # 品名 挿入行数 2 100 りんご、バナナ 1 101 LEN(B2)-LEN(SUBSTITUTE(B2,"、","")) 3 200 もも 0 4 300 メロン、イチゴ、サクランボ 2 302 5 400 なし、レモン 1 401 6 500 すいか 0 7 600 、、、、、、、、、 9 609 8 700 なし、レモン 1 701 9 800 すいか 0 10 101 11 302 12 302 13 401 14 609 15 609 16 609 17 609 18 609 19 609 20 609 21 609 22 609 23 701 24 (aki)さんはVBAをご存知なので、VBAで処理すれば何でも(?)出来ますよね。 でも時間がかかり過ぎるのですよね? .Insertは特にね・・ そこで、考え方(処理の手順)を書いてみます。 1. A列に # を挿入する 2. Data最終行迄、10刻み 又は 100刻みで番号を振る ・上記は 100刻みの例:"、"の最大数で刻み幅を調整 3. 追加開始行(上記の場合 Row=10)を得る 4. 挿入行数(品名:B列の "、"の数)を数える 5. 挿入行数が 0:Zeroでなければ ・A列 + 挿入行数の値を、その個数分追加開始行から追加する ・当然、追加開始行も Countupしておく 6. Data最終行迄の処理が終わり、#(A列)でSortすれば終了 ・必要に応じて A列の削除 ★この手順の、3 〜 5が比較的簡単なVBAでしょうか? 尚、上記の、C 〜 E列は参考迄に書いたものです。 （caro） 2016/07/28(木) 12:36 ---- （β） 2016/07/24(日) 07:46 でレスした数式案ですけど、βは、もともと数式が苦手で Dictionaryと配列でこのテーマを処理するVBAコードを書いて、そのコードでやっていることを 無理やり数式に直して、回答案としました。 その時に書いたVBAコード、参考まで、以下アップしておきます。 Sub Sample() Dim v As Variant Dim dic As Object Dim c As Range Dim x As Long Dim n As Long Dim k As Variant Dim w As Variant Set dic = CreateObject("Scripting.Dictionary") x = 1 For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp)) n = Len(c.Offset(, 1).Value) - Len(Replace(c.Offset(, 1).Value, "、", "")) dic(c.Value) = Array(x, c.Value, c.Offset(, 1).Value) x = x + n + 1 Next ReDim v(1 To x, 1 To 2) For Each k In dic w = dic(k) v(w(0), 1) = w(1) v(w(0), 2) = w(2) Next Range("A2").Resize(UBound(v, 1), 2).Value = v End Sub （β） 2016/07/28(木) 12:53 ---- γさま、βさま、syさま、caroさま こんな、無知無能な自分に ありがとうございます。 一つずつ、自分なりに勉強させてください。 こんなに投稿していただき感謝申し上げます。 取り急ぎ御礼まで。 後日連絡させていただきます。 本当にありがとうございました。 （aki） 2016/07/28(木) 22:37 ---- こんばんわ。 配列での方法を提示しておきます。 test1は元のデータが5万行くらいまでしか使えませんが、メンテナンスフリーです。 test2は、Const rowNo As Long = 50000 の 50000 を大きくすれば、5万行以上のデータも扱えます。 列数はA・B列以上の可能性もあると思いましたので、自動で最大列数を取得するようにしています。 ただ関数などがあれば、値に変換されてしまいます。 Sub test1() Dim r Dim cnt As Long Dim buf() As String Dim ia As Long Dim ib As Long Dim j As Integer '変数に格納 r = Range("A2").CurrentRegion.Columns(2).Value cnt = UBound(Split(Join(WorksheetFunction.Transpose(r), "、"), "、")) + 1 r = Range("A2").CurrentRegion.Value ReDim buf(1 To cnt, 1 To UBound(r, 2)) '変数内で書き込み ib = 1 For ia = 1 To UBound(r, 1) For j = 1 To UBound(r, 2) buf(ib, j) = r(ia, j) Next j ib = ib + UBound(Split(r(ia, 2), "、")) + 1 Next ia 'シートに書き出し Range("A2").Resize(cnt, UBound(r, 2)).Value = buf End Sub Sub test2() Const rowNo As Long = 50000 Dim r Dim buf() As String Dim ia As Long Dim ib As Long Dim j As Integer '変数に格納 r = Range("A2").CurrentRegion.Value ReDim buf(1 To rowNo, 1 To UBound(r, 2)) '変数内で書き込み ib = 1 For ia = 1 To UBound(r, 1) For j = 1 To UBound(r, 2) buf(ib, j) = r(ia, j) Next j ib = ib + UBound(Split(r(ia, 2), "、")) + 1 Next ia 'シートに書き出し Range("A2").Resize(rowNo, UBound(r, 2)).Value = buf End Sub （sy） 2016/07/28(木) 23:12 ---- こんばんわ いろいろとありがとうございました。 ご教示頂きました最初のもので動きましたので、取り急ぎこれを使用させていただきました。 ありがとうございました。落ち着いたら、順次勉強させていただく所存です。 話は変わりますが、以下のように変更できないものか、ご相談に参りました。 考え方をご教示頂きたく存じます。 _____[A]_____ _____[B]_____ [1] [2] A店 りんご、バナナ [3] B店 もも [4] C店 メロン、イチゴ、サクランボ [5] D店 なし、レモン [6] E店 すいか [7] [8] [9] [10] A店 りんご [11] A店 バナナ [12] B店 もも [13] C店 メロン [14] C店 イチゴ [15] C店 サクランボ [16] D店 なし [17] D店 レモン [18] E店 すいか イメージといたしましては、行挿入した分だけA列を下にコピーし B列の2個目をその下に、3個目をさらにその下に挿入できればと考えています。 可能なのであれば、切り取りではなく、値として貼り付けカンマ以降を削除できれば一番理想です。 よろしくお願いします。 （aki） 2016/07/30(土) 18:00 ---- 可能ですので皆さんから回答があると思いますし、私も時間が取れたら書いてみますけど このレイアウト、結果を同じシートの10行目から表示になっていますね。 ということは、元データは最大でも8行だけということでいいのですか? 元データの行数には制限を設けず、結果を別シートに展開するほうが、運用しやすいのではないでしょうか? （β） 2016/07/30(土) 18:56 ---- 私の好みは↑のとおり、別シート展開ですが、とりあえず、γさんがアップされたコードを借用して 同じ場所で（つまり2行目から）対応するコードです。 Sub 行挿入2() Dim i As Long Dim s As String Dim temp As Long Dim w As Variant Application.ScreenUpdating = False For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 s = Cells(i, 2).Value temp = Len(s) - Len(Replace(s, "、", "")) If temp > 0 Then Rows(i + 1).Resize(temp).Insert w = Split(s, "、") Cells(i, 1).Resize(temp + 1).Value = Cells(i, 1).Value Cells(i, 2).Resize(temp + 1).Value = WorksheetFunction.Transpose(w) End If Next End Sub （β） 2016/07/30(土) 19:10 ---- こんばんわ。 元々のakiさんが作成されたコードや、皆さんの提示された方法やコードも、全て元のデータを変更するようになっていますが、 元データの下に複製を作って、今回のレイアウトのようになさりたいと言う事ですか? 仮に数万行あるとすれば、下に追記とすれば、かなりスクロールしなければいけないので、相当見づらくなると思います。 元のデータを残しておきたいのなら、βさんの言われるように別シート転記が良いと思います。 ＞ご教示頂きました最初のもの これはβさんのDictionaryのコードでしょうか? それともγさんが修正してくれたInsertのコードでしょうか? 以前にもお聞きしましたが、元データはどれくらいの行数あるんでしょうか? 処理に時間がかかると言う事でしたので、相当な行数だと思うのですが? βさんが再提示されたコードで速度的にも問題ないと言うのでしたら良いですけど、 ＞=LEN(B2)-LEN(SUBSTITUTE(B2,"、",""))+1 この数式ですと数万行くらいなら一瞬で計算されるはずなので、Insertで時間がかかってると思うんですが。 （sy） 2016/07/30(土) 19:56 ---- (23:29) テストプロシジャといえ、あまりにも無様だったので入れ替えです。 データ件数が不明なんですが、確かに syさん指摘の通り、Insertはきわめて処理コストが重い処理です。 こちらで10万行のデータを作って、テストコードを走らせると戻ってこなかったので 1000行に減らして処理。 下記 Test1 、単純に各行の下に3行の行挿入をしているだけなんですが、それでも 当方環境で30秒。 （当方環境は、かなり性能がよろしい環境です） 一方、これに、数式もセットしたもので実行（Test2)しますと、85秒かかりました。 行挿入のつど数式が再計算されますので、これも道理かなと思います。 Sub Test1() Dim i As Long Dim t As Double Cells.Clear Range("A1:A1000") = "AAAA、BBBB" '計測 t = Timer For i = 1000 To 1 Step -1 Rows(i + 1).Resize(3).Insert Next MsgBox Timer - t End Sub Sub Test2() Dim i As Long Dim t As Double Cells.Clear Range("A1:A1000") = "AAAA、BBBB" Range("B1:B1000").Formula = "=LEN(A1)-LEN(SUBSTITUTE(A1,""、"",""""))+1" '計測 t = Timer For i = 1000 To 1 Step -1 Rows(i + 1).Resize(3).Insert Next MsgBox Timer - t End Sub （β） 2016/07/30(土) 23:25 ---- ＞下記 Test1 、単純に各行の下に3行の行挿入をしているだけなんですが、それでも 当方環境で30秒 そこまで時間はかからないような気がしますが? （マナ） 2016/07/30(土) 23:38 ---- ↑でも10万行では…、 試さなきゃよかったです。 追加の質問の場合は、 速度面だけでなく、わかりやすさでも 配列を使用するほうが良い気がします。 Sub test() Dim w(), v, s Dim i As Long, j As Long, n As Long ReDim w(1 To Rows.Count, 1 To 2) v = Range("a1").CurrentRegion.Value For i = LBound(v) To UBound(v) s = Split(v(i, 2), "、") For j = LBound(s) To UBound(s) n = n + 1 w(n, 1) = v(i, 1) w(n, 2) = s(j) Next Next Range("a1").Offset(UBound(v) + 2).Resize(n, 2).Value = w End Sub （マナ） 2016/07/30(土) 23:57 ---- >>そこまで時間はかからないような気がしますが? まさしくです!!! どうやら、10万件処理中に、強制終了させ、それも何度か繰り返した後に 1000件に減らしたんですが メモリーがグチャグチャになった状況だったかも。 今やってみると、Test1 は 0.6秒、Test2 は 1.2秒 ぐらいですね。 ただ、これを繰り返しますと 0.6 --> 0.9 --> 1.2 -->・・・ と、だんだん増加していきますね。 いずれにしても、 ・そんなにはかからないけど、繰り返すと結構かかってしまう。 ・式がある場合は、その倍ぐらいかかる。 こんな状況です。 で、新しい要件処理の配列バージョンです。（今回は、配列のみで Dictionaryは使いませんでした） Sub Sample2() Dim c As Range Dim v As Variant Dim w As Variant Dim n As Long Dim a As String Dim x As Long Dim d As Variant With Range("B2", Range("B" & Rows.Count).End(xlUp)) a = .Address n = .Rows.Count + Evaluate("SUM(LEN(" & a & ")-LEN(SUBSTITUTE(" & a & ",""、"","""")))") ReDim v(1 To n, 1 To 2) '挿入後のデータ格納配列 For Each c In .Cells w = Split(c.Value, "、") For Each d In w x = x + 1 v(x, 1) = c.Offset(, -1).Value v(x, 2) = d Next Next End With Range("A2:B2").Resize(UBound(v, 1)).Value = v End Sub （β） 2016/07/31(日) 00:04 ---- ↑ あっ! ほとんど、マナさんのコードと【まんま】のコードでした。 （β） 2016/07/31(日) 00:06 ---- βさま ありがとうございます。 情報が少なく申し訳ございません。 行数としては、約1万行で、元のデータを残し、別シートにて展開しております。 また、仰る通り、γさまのコードを使用させていただいております。 syさま ありがとうございます。 情報が少なく申し訳ございません。別シートに展開しております。 みなさまありがとうございます。 また進捗後、報告させていただきます。 よろしくお願いします。 （aki） 2016/07/31(日) 00:18 ---- こんばんわ。 1万行ならtest1を変形させた方で使えるので、マナさんやβさんと被りますが、別シートに転記する案は考えていたので提示だけしておきます。 後余談ですけど、どちらも非常に高速なので気にするほどの差にならないですけど、 Len(s) - Len(Replace(s, "、", "")) より、UBound(Split(s, "、")) の方が倍くらい早いですね。 Sub test3() Const sh1Name As String = "Sheet1" Const sh2Name As String = "Sheet2" Dim sh1 As Worksheet Dim sh2 As Worksheet Dim ary Dim r Dim rowNo As Long Dim buf() As String Dim ia As Long Dim ib As Long Dim j As Integer '変数に格納 Set sh1 = Sheets(sh1Name) Set sh2 = Sheets(sh2Name) r = sh1.Range("A2").CurrentRegion.Columns(2).Value rowNo = UBound(Split(Join(WorksheetFunction.Transpose(r), "、"), "、")) + 1 r = sh1.Range("A2").CurrentRegion.Value ReDim buf(1 To rowNo, 1 To UBound(r, 2)) '変数内で書き込み ib = 1 For ia = 1 To UBound(r, 1) ary = Split(r(ia, 2), "、") For j = 0 To UBound(ary) buf(ib, 1) = r(ia, 1) buf(ib, 2) = ary(j) ib = ib + 1 Next j Next ia 'シートに書き出し sh2.Range("A:B").ClearContents sh2.Range("A2").Resize(rowNo, UBound(r, 2)).Value = buf End Sub （sy） 2016/07/31(日) 01:16 ---- マナさん、syさんがおっしゃるように、配列操作が適切だと私も思います。 （他の方からの示唆もあるかと思います。） 配列操作をマスターすると、また、守備範囲も広がるでしょう。 ところで、最初の私の対応が適当だったのかどうか、反省はあります。 下からという点にだけこだわってしまい、 全体として何をされたいのか、という視点がまるで落ちていました。 挿入するだけで済むわけはないですわねえ。 質問者さんも、最初からもう少し全体像を示してもらうとよかったかもしれませんね。 （γ） 2016/07/31(日) 09:33 ---- γさま ご指摘ありがとうございました。 今後ともよろしくお願いします。 （aki） 2016/07/31(日) 16:49 ---- こんばんわ 先日は大変お世話になりました。ありがとうございました。 お陰様で、無事に稼働いたしております。本当に感謝の気持ちです。 今回の内容に近いお話なのですが、ご教示をよろしくお願いします。 以下のような表があります。 A列に店舗名、B列に、種類、C列に種類細目、D・F・H・J・L列に日付、E・G・I・K・M列に都道府県が入っております。(表ではI列まで記載) A列は、B列のカンマの数だけコピーし、B・C列、D・F・H列、E・G・I列は、その挿入した欄に各々値でコピーしたいのです。 行数は、約12,000行です。 何度もすいません。何卒ご教示くださいますようお願い申し上げます。 A B C D E F G H I A店 やさい キャベツ 5/1 北海道 A店,B店 やさい、くだもの にら、りんご 5/2 青森 5/2 秋田 B店,C店 パン、お肉 アンパン、豚 5/2 神奈川 5/2 岐阜 A店,B店、C店 やさい、さかな、お肉 レタス、ブリ、鳥 5/3 埼玉 5/3 東京 5/4 群馬 A B C D E A店 やさい キャベツ 5/1 北海道 A店,B店 やさい にら 5/2 青森 A店,B店 くだもの りんご 5/2 秋田 B店,C店 パン アンパン 5/2 神奈川 B店,C店 お肉 豚 5/2 岐阜 A店,B店、C店 やさい レタス 5/3 埼玉 A店,B店、C店 さかな ブリ 5/3 東京 A店,B店、C店 お肉 鳥 5/4 群馬 （aki） 2016/07/31(日) 18:15 ---- 配列を使ったコードが理解できていないということでしょうか。 （マナ） 2016/07/31(日) 18:33 ---- こんばんわ。 確認したい事が3点あります。 1,B列とC列の[、]の数は必ず同じになるんですか? もし違う場合はどういう表現にするんですか? D列からI列に関しても同じで、[、]の数と同じだけの列数になるんですか? 2,またB列[文字1、文字2、文字3、文字4、文字5]の順番と、 C列[文字6、文字7、文字8、文字9.文字10]、 [D・E列、F・G列、H・I列、J・K列、L・M列]の並び順は同じで良いんですか? 3,元データの列数は、今後M列以上になる事はあり得ませんか? 修正に関してですが、 配列領域の確保の部分は、列で[、]の数が異なるのでしたら、マナさんのか私のtest2のような予め十分に大きい領域を確保しておくと言うのが良いですね。 配列へのデータ格納部分は誰のを使っても正直全く同じなので、修正方法も同じになるんですが、 (変数名が違うのとループの方法がFor iかFor Eact使ってるかだけの違いだけです) C列の文字分割転記に関しては、B列のと同じように行えば良いだけですが、D列からM列の部分は配列に慣れていないと難しいかも知れませんね。 配列案なら誰のコードでも修正方法は同じになると思うので、今現在使用されているコードと(変数名などが若干違うので) 何処までが理解されていて、何が分からないかを提示されてはどうでしょうか。 （sy） 2016/07/31(日) 19:56 ---- 現在、最初のテーマで、akiさんが採用した方式によるコード、これを元に回答側から回答案を提示したほうが わかりやすいと思います。 皆さんからいろいろな方式の提示があったわけですが、 >>お陰様で、無事に稼働いたしております ということですから、まずは、そのコードをアップして、この方式でやっているんだと示されたらよろしいかと。 （β） 2016/07/31(日) 20:01 ---- 回答とは関係のないコメントですのでスルーいただいてもOKです。 提示のレイアウトは、何か、取引の実績をある単位で入力したものでしょうかね。 で、そうだとして眺めた場合 B列に やさい、くだもの、パン、お肉 というものがあったとします。 これは C列の たとえば かぼちゃ、りんご、メロンパン、合い挽き といったものと対になるわけですよね。 その組み合わせと順番を間違えずに B列とC列に入力する。 う〜ん・・・結構、入力間違いが発生しそうですね。 たとえば B列は入力せず、レイアウトでいえば C列のデータだけを入力する。 別途、かぼちゃ は やさい、りんご は くだもの といった紐付けテーブルを持っておいて、B列情報は そこから抽出する。マクロ処理にしろ関数処理にしろ、それがデータ入力仕様の原則だと思いますよ。 （β） 2016/07/31(日) 20:25 ---- syさま 早急にありがとうございます。感謝いたします。 以下インラインにて返答させていただきます。 ＞1,B列とC列の[、]の数は必ず同じになるんですか? はい、システムからCSVで吐き出されるため、必ず数は同じです。 ＞2,またB列[文字1、文字2、文字3、文字4、文字5]の順番と、 C列[文字6、文字7、文字8、文字9.文字10]、 [D・E列、F・G列、H・I列、J・K列、L・M列]の並び順は同じで良いんですか? はい、同じ並び順で大丈夫です。 ＞ 3,元データの列数は、今後M列以上になる事はあり得ませんか? はい、ございません。1万件行かないぐらいの数字ですので、大目にしております。 ＞ 配列案なら誰のコードでも修正方法は同じになると思うので、今現在使用されているコードと(変数名などが若干違うので) 何処までが理解されていて、何が分からないかを提示されてはどうでしょうか。 申し訳ありません。おっしゃる通りです。しかしながら、全く分からないのが正直なところです。 （aki） 2016/07/31(日) 21:15 ---- どのコードを踏まえておられるのかが不明ですので、とりあえず、私がアップした Sample2 を踏まえて書きました。 Sub Sample3() Dim shF As Worksheet Dim shT As Worksheet Dim c As Range Dim v As Variant Dim wB As Variant Dim wC As Variant Dim n As Long Dim a As String Dim x As Long Dim i As Long Set shF = Sheets("Sheet1") '元シート Set shT = Sheets("Sheet2") '展開シート '転記シートタイトル行以外をクリア shT.Range("A1", shT.UsedRange).Offset(1).ClearContents With shF.Range("B2", shF.Range("B" & Rows.Count).End(xlUp)) a = .Address '展開データの総行数 n = .Rows.Count + Evaluate("SUM(LEN(" & a & ")-LEN(SUBSTITUTE(" & a & ",""、"","""")))") ReDim v(1 To n, 1 To 5) '展開データ格納配列 For Each c In .Cells wB = Split(c.Value, "、") wC = Split(c.Offset(, 1).Value, "、") If UBound(wC) <> UBound(wB) Then MsgBox c.Row & "行目のB列、C列が不整合のため処理をスキップします" Else For i = LBound(wB) To UBound(wB) x = x + 1 v(x, 1) = c.EntireRow.Range("A1").Value v(x, 2) = wB(i) v(x, 3) = wC(i) v(x, 4) = c.EntireRow.Range("D1").Offset(, i * 2).Value v(x, 5) = c.EntireRow.Range("D1").Offset(, i * 2 + 1).Value Next End If Next End With shT.Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v shT.Select End Sub （β） 2016/07/31(日) 21:33 ---- To βさん 何かβさんのコードでエラーが。 v(x, 1) = c.EntireRow.Range("A1").Value の所で「実行時エラー9 インデックスが有効範囲にありません。」になりますね? test3を修正したコードです。 列数がI列・M列どちらでも対応していますが、[、]の数とD列以降の列数の不一致のエラー処理はしていません。 Sub test4() Const sh1Name As String = "Sheet1" Const sh2Name As String = "Sheet2" Dim sh1 As Worksheet Dim sh2 As Worksheet Dim ary1, ary2, r Dim rowNo As Long Dim buf() As String Dim ia As Long Dim ib As Long Dim j As Integer '変数に格納 Set sh1 = Sheets(sh1Name) Set sh2 = Sheets(sh2Name) r = sh1.Range("A2").CurrentRegion.Columns(2).Value rowNo = UBound(Split(Join(WorksheetFunction.Transpose(r), "、"), "、")) + 1 r = sh1.Range("A2").CurrentRegion.Value ReDim buf(1 To rowNo, 1 To 5) '変数内で書き込み For ia = 1 To UBound(r, 1) ary1 = Split(r(ia, 2), "、") ary2 = Split(r(ia, 3), "、") If UBound(ary1) = UBound(ary2) Then For j = 0 To UBound(ary1) ib = ib + 1 buf(ib, 1) = r(ia, 1) buf(ib, 2) = ary1(j) buf(ib, 3) = ary2(j) buf(ib, 4) = r(ia, j * 2 + 4) buf(ib, 5) = r(ia, j * 2 + 5) Next j End If Next ia 'シートに書き出し sh2.Range("A2:E" & Rows.Count).ClearContents sh2.Range("A2").Resize(rowNo, 5).Value = buf End Sub （sy） 2016/07/31(日) 23:22 ---- >>何かβさんのコードでエラーが。 こちらで、13000行ぐらいのテストデータを作成して、問題なく処理できていますが、B列文字列の状態によって n = .Rows.Count + Evaluate("SUM(LEN(" & a & ")-LEN(SUBSTITUTE(" & a & ",""、"","""")))") これで意図した行数の取得ができないケースがあるのでしょうか・・・ 皆さんがやっておられるように ReDim v(1 To n, 1 To 5) '展開データ格納配列 を ReDim v(1 To Rows.Count, 1 To 5) '展開データ格納配列 に変更し shT.Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v を shT.Range("A2").Resize(x, UBound(v, 2)).Value = v に変更したほうが安全かもしれませんね。 （β） 2016/08/01(月) 00:08 ---- To βさん エラーの原因が分かりました。 n = .Rows.Count + Evaluate("SUM(LEN(" & a & ")-LEN(SUBSTITUTE(" & a & ",""、"","""")))") の所で、要素数が正しく取得出来ていないみたいです。 shF がアクティブになっていない時は取得できないようですね。 a = .Address(External:=True) にすればエラーは出ないですね。 （sy） 2016/08/01(月) 00:10 ---- To sy さん わぁ! 考えてみれば当たり前でした。（汗、汗・・お恥ずかしい） デバッグ、ありがとうございました。 To aki さん もし、β の Sample3 を試す場合は、 sy さんご指摘のように a = .Address を a = .Address(External:=True) あるいは n = .Rows.Count + Evaluate("SUM(LEN(" & a & ")-LEN(SUBSTITUTE(" & a & ",""、"","""")))") を n = .Rows.Count + shF.Evaluate("SUM(LEN(" & a & ")-LEN(SUBSTITUTE(" & a & ",""、"","""")))") に変えて試してください。 （β） 2016/08/01(月) 06:35 ---- βさま コーディング有難う御座いました。感謝申し上げます。 Sample3のコードを、ご指摘いただきました内容で変更させて頂きました。 ばっちりです。本当に有難う御座います。 syさま コーディング有難う御座いました。感謝申し上げます。 みなさまへ 本当にお付き合いを頂き有難う御座いました。 何時の日か、質問者から回答者になれるように努力します。 また勉強させて下さい。よろしくお願いします。 （aki） 2016/08/01(月) 20:41... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201607/20160723235008.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97023 documents and 608156 words.
訪問者：