- ベストアンサー
【VBA】配列を使ったマクロで高速化
Hirorin_20の回答
- Hirorin_20
- ベストアンサー率20% (136/648)
>セルを直接参照するより、配列を使った方が速くなるという話を聞いたのですが、 理由は単純です。配列はメモリ上に取られるので早いのです。 >For i = 1 To 10000 >For j = 1 To 10000 1万回の繰り返しの中で1万回繰り返したら、1億回の繰り返しですよね。どうしても必要なら仕方ないですけど、回数は少なくしましょう。ちょっと知恵を絞ればできます。 例えば、ソートしておいてから比較すればかなり少なくなります。 あるいは合わせて2万個を1つの配列にしてソートすれば前後だけで一致をチックできるのでものずごく回数が減りますよね。
関連する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
- 締切済み
- その他(業務ソフトウェア)
お礼
あーすみません。それはすでにしています。 上のは配列に関することのみに要点を置いてるのでそこは端折りました。 (excelのソートの規則性がいまいちわからず四苦八苦してますが） 私は上記プログラム純粋に配列のみで可能かどうかを聞きたいです。