- ベストアンサー
【VBA】配列を使ったマクロで高速化
cj_moverの回答
こんにちは。＃３、ｃｌです。 ＃３の訂正が１点、 補足が２点、 お礼欄でのお尋ねに関するこたえを最後に書きます。 訂正■ > a = Range("A1:B" & nBtmRow).Value > ReDim b(1 To UBound(a), 1 To 1) > For i = 1 To nBtmRow ↑これ間違えました。正しくは↓ a = Range("A1:B" & nBtmRow).Value ub = UBound(a) ReDim b(1 To ub, 1 To 1) For i = 1 To ub たまたま Range("A1:... のように１行目から始まる範囲だから通ってしまいますが 実際は、配列の中身（インデックス）と行番地は相対ですから あらためて UBound() 採らないとおかしいですね。失礼しました。 ちなみに、ub = UBound(a) ですが、これ a は２次元配列ですから、 省略しないで ub = UBound(a, 1) と書く方がベターでした。 （※ubはLong型です） 補足１■ > のように、ひとつずつ、処理するよりは > Range("A2,A4,A6,A8,A10").Interior.ColorIndex = 3 > のように、プロパティ設定を一度で済ませた方が 合わせて書かなければいけなかったのですが、 「オブジェクトの参照・取得とプロパティ設定を一度で済ませた方が」 です。 要は"時間が掛かる処理"はなるべく減らそうということなので片手落ちはまずかったですね。 補足２■ > 配列を使って、作業セルに作業用のフラグ配列を出力して 提示したサンプルコードでいうとフラグ配列とここで呼んでいるのは [True | Empty]です。フラグ配列というと普通は[True | Flase]ですね。 でもExcelの .SpecialCells() にとって、フラグと呼べるのは "セルの値のデータ型の相違"ですから、 [Boolean | Empty]という二値をVariant型の変数に格納した後で配列ごとセル範囲に出力している と、ちゃんと説明するべきでした。 これが理由で Variant型 の変数配列を使うのですし、 逆に Variant型 でなければできないことをしている訳です。 ＃３へのコメントへのレス■ > 1つ気になったのが、rangeオブジェクトでまとめて選択する方法として > Joinの例をあげましたが、Unionを使わないのはやはり時間がかかるからですか？ 端的にいうと「はい」その通りです。 少なくとも、 Set rng = Union(rng, rng2) のように、ひとつずつ追加していくのは、割と時間掛かります。 とはいっても、Unionしないで、ひとつずつプロパティ設定をするよりは速いですから 処理を速くする方法のバリエーションのひとつに加えておいても良いと思います。 ただ、Union メソッド は、Range型の引数３０個まで指定できますから、 私のスタイル（つまり好み）として、ひとつずつ追加していくことは全くやらないだけです。 加えて言うと、例えば Union(Range("A2"), Range("A4")) なんて、普通の人でもばかばかしくて書かないですよね。 Range("A2,A4") （←↑厳密には少し意味が違いますが。） の方がはるかに速いですし。 で、突き詰めていくと、（少し私の話になってしまいますが） Range() に指定できる参照文字列は２５５文字まで目いっぱい使って Union() に指定できるRange型の引数は３０個まで目いっぱい使って ３０個ずつまとめたものを更にUnionして Areas３２７６７を超えないように手当てして、なんて、やっていくと 配列を引数にしてRangeオブジェクトを返す関数が出来て、 .SpecialCells とかExcelの一般機能使うより数倍速くすることは 可能だということを確かめたりもしました。 経験上、面倒だったのは、いつも数字の壁（仕様上の制限）だったので、 考えないで済むのなら、なるべく有利な環境に限定したものを 書いていった方が、取っ掛かりとしてはやり易いと思います。 （＃この↑３行で済む話を長々書いた感もありますが（汗） もし興味があれば↓ For Nextマクロの高速化についてご教示ください。 http://okwave.jp/qa/q4007086.html 私の"ガラパゴスなＶＢＡ"の話よりも他の方のが参考になるかもしれません。 あ、↑の質問者さんも"高速化"探究し続けていた方なので色々ヒントとか 共通の疑問とか、見つけやすいかも知れませんね。 それでは。。。
関連するQ&A
- VBA 配列について
配列の使い方について教えてください １つの配列をどんどん追加したりしたいので１つの mybox で追加していきたいと思っています。 （下記コードが実現できればと思います。） (1)配列を広げ追加したい (2)繰返しを使わず一気に書き込みたい (3)一部をクリアしたりしたい のですがよろしくお願いします。 Sub Macro1() Range("A1").Value = "A" Range("A2").Value = "B" Range("A3").Value = "A" o = Range("A1").End(xlDown).Row mybox = Range(Cells(1, 1), Cells(o, 1)).Value 'myBox(1,1)=A 'myBox(2,1)=B 'myBox(3,1)=A ←このような表示になります。 '------------------------------------------------- '(1)配列を広げ追加したい ReDim Preserve mybox(o, 2) For i = 1 To UBound(mybox) If mybox(i, 1) = A Then mybox(i, 2) = 0 Else mybox(i, 2) = 1 End If Next i '------------------------------------------------- '(2)(1)をＣ列に「myBox(?,2)を「繰返しを使わず一気に」書き込みたい 'Transposeは限界（65536個）を超えるので使えません。 Range(Cells(1, 3), Cells(UBound(mybox), 3)) = mybox '(3)配列myBox(？,1)は残したままmyBox(？,2)はクリアにしたい End Sub
- ベストアンサー
- Visual Basic
- EXCEL VBAの配列でわかりません。
こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBAマクロについて質問です
Excel VBAマクロについて質問です ※Excel Ver.は2005でやってます 例のような感じで、 同じ列（列１）に或る同じ列名の数字（列２）を足して 違うセル、または違うブックの指定行に合計値を横並び表示させたいのですがうまくいきません 例のように 同じ言葉が含まれているもの（りんご・青りんご）は足して出したいと思ってます 【理想】実行前 ****************************** 番号 名前 個数 001 りんご 1 002 ばなな 2 003 いちご 3 001 青りんご 2 ****************************** 【理想】実行後 ****************************** 番号 りんご ばなな いちご 001 3 - - 002 - 2 - 003 - - 3 ****************************** ※「-」記号はついてなくても大丈夫です 現在、組んでいるコード・実行結果をのせておきました どなたか享受ください、お願いいたします j = 1 For i = 0 To Range("A65536").End(xlUp).Row cnt = cnt + Range("列２" & i).Value If Range("C" & i + 1).value <> Range("C" & i).value Then 'もし次の行が違う名 Range("任意セル" & j).Value = Range("A" & i).Value '列１ Range("任意セル" & j).Value = Range("B" & i).Value '列２ Range("任意セル" & j).Value = cnt '数字合計 j = j + 1 '出力行カウントアップ cnt = 0 End If Next
- 締切済み
- その他（プログラミング・開発）
- 行ごとに判定するマクロについて教えて下さい
行ごとに判定するマクロについて教えて下さい。 下記のようなマクロで、添付ファイルのように、行ごとで E列からN列で違った数値がないか、入力されていないセルがないかを調べ ４つすべてのセルが同じ数値でない場合は塗りつぶしはされず O列にOKを表示しないようなマクロを組みたいのですが 現在のマクロだと、行ごとではなく、E3～N102セルまでの中で 同じ数値がないかを判断してしまっているため K11セルやK15セルのように数値が入力されていないにも関わらずO列の部分にOKが出てしまいます。 他の行に同じ数値が入っているのは関係なしにして 11行目なら11行目だけで 15行目なら15行目だけで、というように行ごに判定していくには どのようにすればいいでしょうか？ Sub 判定マクロ回転() Dim i As Integer, j As Integer Range(Cells(3, 15), Cells(102, 15)).ClearContents For i = 3 To 102 For j = 5 To 14 Cells(i, j).Interior.ColorIndex = 0 If WorksheetFunction.CountIf(Range("E3:N102"), Cells(i, j)) > 3 Then If Cells(i, j).Row Mod 2 = 1 Then Cells(i, j).Interior.ColorIndex = 6 Cells(i, 15) = "OK" Else If Cells(i, j).Row Mod 2 = 0 Then Cells(i, j).Interior.ColorIndex = 40 Cells(i, 15) = "OK" End If End If End If Next j Next i If WorksheetFunction.CountIf(Range("O3:O102"), "OK") > 99 Then MsgBox "データチェックOK(^O^)b" End If End Sub
- ベストアンサー
- Excel（エクセル）
- ExcelのVBAがオーバーフローに！？
読んで頂きありがとうございます。 以前に質問しました時に回答を頂き凄く助かっていたのですが、何故か「オーバーフロー」と表示されてしまいます。 ひょっとしたら桁なのかも知れません。 下記のVBAを教えて頂きしようしていました。 Option Explicit Sub Test() Dim c(), p(), q(), i, j, l, r, k As Long r = Range("B2").End(xlDown).Row l = Range("D2").End(xlDown).Row ReDim c(r - 2), p(r - 2), q(r - 2) For i = 1 To r - 2 c(i) = Cells(i + 2, 2).Value p(i) = Cells(i + 2, 3).Value q(i) = i + 2 Next i For i = 1 To r - 3 For j = i + 1 To r - 2 If c(i) > c(j) Then k = c(i) c(i) = c(j) c(j) = k k = p(i) p(i) = p(j) p(j) = k k = q(i) q(i) = q(j) q(j) = k End If Next j Next i For i = 1 To r - 2 Cells(i + 2, 7).Value = c(i) For j = 3 To r If Cells(j, 4).Value = c(i) Then Cells(i + 2, 8).Value = p(i) - Cells(j, 5).Value If p(i) - Cells(j, 5).Value <> 0 Then Range("B" & q(i)).Interior.ColorIndex = 6 Range("D" & j).Interior.ColorIndex = 6 End If Exit For End If Next j Next i For i = 3 To r k = 0 For j = 3 To l If Cells(i, 2).Value = Cells(j, 4).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("B" & i).Interior.ColorIndex = 35 End If Next i For i = 3 To l k = 0 For j = 3 To r If Cells(i, 4).Value = Cells(j, 2).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("D" & i).Interior.ColorIndex = 35 End If Next i End Sub デパックのClickすると15行目辺りの「k = c(i)」が黄色くなります。 正直言ってマクロとか全く解りませんが、コピーして使っていました。 どこをどう変更すれば良いのか教えて頂ければ助かります。 よろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- エクセルVBAで配列内に空白データを入れる場合
エクセル2000です。 ある大きな表のうち、0値を非表示ではなく完全に削除するために以下のようなマクロを書いてみました。 一旦配列に取り込んでいるのは高速化のためです。 これで見た目には目的を達しているのですが、実際には0値が長さ０の文字列に変わっただけで完全な空白にはなっていません。 配列にとりこまず、セルをループして0値のセルをClearすれば解決するのはわかるのですが、ほかにいい方法はないでしょうか？ Sub TEST0値() Dim myAr With ActiveSheet x = .Range("A" & Rows.Count).End(xlUp).Row myAr = .Range("A4:AP" & x).Value For i = LBound(myAr, 1) To UBound(myAr, 1) For n = LBound(myAr, 2) To UBound(myAr, 2) If myAr(i, n) = 0 Then myAr(i, n) = "" Next n Next i .Range("A4:AP" & x).Value = myAr End With End Sub
- ベストアンサー
- その他MS Office製品
- 特定の文字列を除いた配列の作成マクロについて
頭書の件、現在マクロで以下のようなことを行おうとしており悩んでおります。 皆様のお知恵を拝借いたしたく、お願いいたします。 エクセルのSheet1に以下のような形でデータが格納されております。 A行：文字列、B行：数字でそれぞれ60000個程度のデータ格納されております。 この中から、特定の文字列を含んだ列を全て削除したデータを配列に格納するマクロを作成したいと考えています。 「特定の文字列」は、例えば"山田", "佐藤", "田中"の３種類とします。 もし上述の文字列のいずれかを含んだデータが30000個あれば、削除後の30000個程度のデータを新しい配列に格納したいと思っています。 イメージ的には以下のような操作がしたいのですが、「If C(i, 1) <> List Then」では通らないので、この部分に該当するような操作をなにかしらの方法で表現できましたらご教授いただけると助かります。 Sub test() Dim C As Variant Dim D As Variant Dim i As Long Dim j As Long Dim List As Variant List = Array("山田", "佐藤", "田中") C = Worksheets("Sheet1").Range("A1", "B6000") For i = 1 To 60000 If C(i, 1) <> List Then D(j,1)=C(i,1) D(j,2)=C(i,2) j=j+1 Else End If Next End Sub お手数をおかけいたしますが、宜しくお願いいたします。
- ベストアンサー
- Visual Basic
- エクセルVBAの配列について
エクセルVBAの配列について VBAをはじめたばかりの初心者です。 現在、下記のようにデータを配列の中に入れ、 別シートに書き出そうとしております。 （配列へ読み込むところのみ） Dim 配列(1 To 件数, 1 To 9) As Variant For j =1 To 件数 For i = 2 To L If Cells(i, 2).Value = Tx_month Then For k = 3 To 11 配列(j, k - 2) = Cells(i, k).Value Next k End If Next j,i 現状では、データの最終行のみを「件数」分書き出してしまいます。 ｊとｉのForが重なっているからだと思うのですが、どう書き直したら良いか分かりません。 質問をさせていただくのも初めてなので、分かりづらく恐縮ですが お力添え頂けますと幸いです。 どうぞ宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- VBA ユーザー関数の作成 （配列を利用 ?)
文字列から特定文字「:」を見つけて その前後の数値（計5文字）を抜き出すVBAが一応できました。 使用列が多く無駄が多いので これをユーザー関数にしたいのですがどのようになりますか ？ セルに書き込む代わりに配列に書き込めば出来そうな気がしますが やり方がわかりません。 例えば、 分秒抜き出し(指定文字列 as string) で結果が5分50秒の場合 350.000 と表示させたい。 ’------------------------------------------------------------------ Option Explicit Sub test() Dim 位置 As Integer Dim name As String Dim i As Long Dim LastNo As Long LastNo = Cells(Rows.Count, "A").End(xlUp).Row 'B列(特定文字の位置) For i = 2 To LastNo name = Range("A" & i).Value Range("B" & i).Value = InStr(name, ":") Next 'C列(特定文字から前の文字列） 'D列(特定文字から後ろの文字列 For i = 2 To LastNo name = Range("A" & i).Value Range("C" & i).Value = Left(name, Range("B" & i) - 1) Range("D" & i).Value = Mid(name, Range("B" & i) + 1) Next 'E列(分を抽出) For i = 2 To LastNo ’10分以下の場合、半角のカッコ又は半角のスペースが前にある （必要なら）追加 If Mid(Range("C" & i), Range("B" & i) - 2, 1) = "(" Or _ Mid(Range("C" & i), Range("B" & i) - 2, 1) = " " Then '9分以下 Range("E" & i) = Right(Range("C" & i), 1) Else '１0分以上 Range("E" & i) = Right(Range("C" & i), 2) End If Next 'F列(秒を抽出) For i = 2 To LastNo Range("F" & i) = Left(Range("D" & i), 2) Next 'G列（分：秒) For i = 2 To LastNo Range("G" & i) = "0:" & Range("E" & i) & ":" & Range("F" & i) Range("G" & i).NumberFormatLocal = "h:mm:ss" Cells(i, "H").Value = Cells(i, "G").Value Cells(i, "H").NumberFormatLocal = "[s].000" '小数点以下で表示 Next End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルマクロで教えてください
マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。１TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub
- 締切済み
- その他(業務ソフトウェア)
お礼
丁寧な補足と回答ありがとうございます。 回答者様のプログラム文が非常に参考になりました。 URL先の方も読まさせていただきます