• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:[VBA]二次元配列を使ったsumif)

[VBA]二次元配列を使ったsumif

このQ&Aのポイント
  • VBAの質問です。環境はWindows XP SP3とExcel 2003です。sumifのような計算を二次元配列を使って行いたいが、処理が遅くなるため、効率的なコードを教えてほしい。データは昇順で並んでいる場合と並び替えることができない場合の2つのパターンについて教えてほしい。
  • 40,000行のデータを集計するためのVBAコードを書いたが、処理が遅くなる。データが昇順で並んでいる場合と並び替えることができない場合の2つのパターンについて、効率的なコードを教えてほしい。
  • VBAを使って二次元配列を使ったsumifのような計算を行いたいが、40,000行のデータを処理するのに時間がかかる。データが昇順で並んでいる場合と並び替えることができない場合の2つのパターンについて、効率的なコードを教えてほしい。

質問者が選んだベストアンサー

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

試しに次のように。 sub macro1()  worksheets("Sheet2").cells.clearcontents  worksheets("Sheet2").range("A1").consolidate _   sources:="Sheet1!" & worksheets("Sheet1").range("A1").currentregion.address(true,true,xlr1c1), _   function:=xlsum, toprow:=true, leftcolumn:=true, createlinks:=false end sub

rihitomo
質問者

お礼

素晴らしいです! そのものずばりのものがあったんですね。 引数:sourcesの指定のやり方が少し独特で慣れないですが、これで希望のものができました! ありがとうございました!

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • 配列を利用したコードにしてください

    下記コードですが 計算速度が遅いので配列を利用した コードに修正してください。お願いいたします。 Dim mx As long Dim Rp As Double Dim yy1 As Double Dim pai As Double Dim Ba AS long Dim i As long, j as long Dim K As Doubke Dim xx1 As Double, yy1 As Double Dim x0 As Double,y0 As Double Dim x1 As Double, y1 As Double mx = Sheets("nn").Range("B65536").End(xlUp).Row Rp1= Sheets("pp").Range("B65536").End(xlUp).Row yy1= Sheets("pp").Range("A25") With Sheets("zzz") pai=Atn(1) * 4 Ba=Sheets("sheet1").Range("A1")  For I = 1 To Ba K = -Sheets("sheet1").Range("B" & I + 3).Value * pai/180 xx1 = Sheets("sheet1").Range("C" & I + 3).Value   yy1 = Sheets("sheet1").Range("D" & I + 3).Value  For j = 1 To mx - 1 x0 = .Cells(2 + j, 2) y0 = .Cells(2 + j, 3) X1 = x0 * Cos(K) + y0 * Sin(K) Y1 = -x0 * Sin(K) + y0 * Cos(K) .Cells(2 + j, 2 * I + 2) = X1 + xx1 - Rp1 .Cells(2 + j, 2 * I + 3) = Y1 + yy1  Next j  Next I End with

  • 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

  • エクセルVBAマクロの質問です。

    マクロ初心者です。行き詰まってます。 sheet1には300件程度のデータがあります。 このデータの3列目の値を、VLOOKUPでsheet3のA1:B30範囲から参照します。そこで取得した回数分、sheet1の各行のデータをsheet2にコピーしたいんです。 そこで、コード文を作ってみましたが、マクロがうまく動きません。 すみませんが、お知恵を貸していただけないでしょうか? Dim Z as Long Dim L As Long Dim P As Long Dim Kensaku As String Dim M4 As Range Dim PRow As Long Dim i As Long Set M4 =Sheets(“sheet3”).Range(“A1:B30“) L = Sheets(“sheet1”).Range(“A1”).End(xlup).Row For Z = 1 to L-1 Kensaku = Sheets(“sheet1”).Cells(Z+1,3).Value P=Worksheetfunction.Vlookup(Kensaku,M4,2,False)    For i = 1 to P      Prow=Sheets(“sheet2”).Range("A1").End(xlDown).Row      Sheets(“sheet1”).Rows(Z+1).Copy Sheets(“sheet2”).Rows(Prow)    Nexti Next Z

  • ExcelのVBAの配列に関する質問です。

    ExcelのVBAの配列に関する質問です。 sheet1のデータをsheet2に表示するVBAを作成しています。。 sheet1のデータは7行目からスタートし、sheet2のデータは26行目からスタートしています。。 sheet1とsheet2の列は同じ並びではないため、それぞれのシートの列番号をCellsを用いて指定しています。 Sub test1() Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 Worksheets("sheet2").Cells(j, 1) = Worksheets("sheet1").Cells(i, 2) Worksheets("sheet2").Cells(j, 8) = Worksheets("sheet1").Cells(i, 28) Worksheets("sheet2").Cells(j, 9) = Worksheets("sheet1").Cells(i, 31) Worksheets("sheet2").Cells(j, 10) = Worksheets("sheet1").Cells(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub 上記のtest1は正常に動くのですが、データ量が多いため、処理に時間がかかってしまいます。 高速化できないかと、以下のように変更しました。 Sub test2() Dim dataRange1 As Variant Dim dataRange2 As Variant dataRange1 = Worksheets("sheet1").Range("A1:GI10006") dataRange2 = Worksheets("sheet2").Range("A1:DZ10018") Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 dataRange2(j, 1) = dataRange1(i, 2) dataRange2(j, 8) = dataRange1(i, 28) dataRange2(j, 9) = dataRange1(i, 31) dataRange2(j, 10) = dataRange1(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub test2は、エラーメッセージ等は表示されませんが、sheet2にデータが表示されません。 ちなみに、以下のようにsheet1のみ配列化した場合は、正常に表示されました。 Worksheets("sheet2").Cells(j, 1) = dataRange1(i, 2) Worksheets("sheet2").Cells(j, 8) = dataRange1(i, 28) Worksheets("sheet2").Cells(j, 9) = dataRange1(i, 31) Worksheets("sheet2").Cells(j, 10) = dataRange1(i, 32) test2は、どこが間違っているのでしょうか? ご教示ください。 よろしくお願いいたします。

  • VBA ループ処理 "型が違います"エラー

    "sheet1"のA1:J1を"sheet2"のA1:J1にコピー "sheet1"のA2:J2を"sheet2"のA2:J2にコピー "sheet1"のA3:J3を"sheet2"のA3:J3にコピー これを"sheet1"A:Jが空欄になるまでループさせたいのですが、 どうしてもエラーが出てしまいます。。。 前回も同様の質問をして、回答を頂いたのですが、 自分なりに応用を利かせてやってみたら、エラーが出てしまいます>< ------------------------------------------------------------ Sub cpy2() Dim i As Long Dim Sht1 As Range Dim Sht2 As Range Set Sht1 = Sheets("Sheet1").Range("A1:J1") ←("A1")ではエラーは出ません。 Set Sht2 = Sheets("Sheet2").Range("A1:J1") ←("A1")ではエラーは出ません。 For i = 0 To 65535 If Sht1.Offset(i) <> "" Then ←ここでエラーが出ます"型が違います" Sht2.Offset(i) = Sht1.Offset(i) Else Exit For End If Next End Sub -------------------------------------------------------------- 教えて下さい。お願いします。

  • Matchの処理について

    下記の処理がどうしてもうまくいかなくて、 皆様のお知恵を拝借できればありがたいです。 Sheet1に下記のように縦に3列データがならんでいます。 A  あ  10 A  い  12 A  う  16 B  あ  19 B  い  15 B  う   7 これをもとにSheet2に下記の通りマトリクス形式に 変換する。   あ  い  う A  10  12  16 B  19  15   7 これを処理しようと以下の通り記述したのですが、 マッチする項目がなかった場合、どうも行(列)が ずれてヒットしているようです。 On Error Resume Nextが原因のような気がするのですが。 これを回避するにはどうしたらよろしいでしょうか? お助けください~。 よろしくお願い致します。 Dim i As Long Dim j As Long Dim k As Long Dim 検索値A As Variant Dim 検索値B As Variant On Error Resume Next i = 2 Do While (Sheets("SHEET1").Cells(i, 1) <> "") 検索値A = Sheets("SHEET1").Cells(i, 1).Value 検索値B = Sheets("SHEET1").Cells(i, 2).Value j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0) k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0) Sheets("Sheet2").Cells(j, k).Value =Sheets("SHEET1").Cells(i, 3) i = i + 1 Loop End Sub

  • VBAの配列について

    初めまして、VBAの配列の入力方法について質問させてください。 大量のデータの処理を高速化するため、配列を使用して以下のVBAを入力しました。 インターネットで調べ、見よう見まねで入力してみたものです…(T_T) 内容は、シート「資料」のC列とシート「Sheet1」のG列の文字列が同じ かつ、シート「資料」のL列から最終列(そのときによって変化します) とシート「Sheet1」のE列の文字列が同じ場合、 シート「資料」のA列~D列及びL列から最終列で文字列の一致したセルを 着色するというものです。 変数「アイス」と「チョコ」にそれぞれシート「資料」のデータと シート「Sheet1」のデータを格納したつもりなのですが、 実行したところ「配列がありません。」というエラーメッセージが 表示されました。 どうやらデータを配列として格納できていないときに表示される エラーメッセージのようなのですが、変数の型を変更してみたり、 配列をアイス(2)にしてみたりと、色々方法を変えて試してみたものの、 処理は成功しませんでした(T_T) 一体何が原因で処理が成功しないのか、どなたかご教授いただけると とても嬉しいです…!よろしくお願いいたします。 ちなみに、配列を使用しない場合の処理は、時間が15分ほどと かなりかかりますが、成功しています。 Application.ScreenUpdating = True Dim アイス, チョコ As Long Dim i As Integer, j As Integer, k As Integer アイス = Sheets("資料").Cells(Rows.Count, 1).End(xlUp).Row チョコ = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row For i = 3 To Sheets("資料").Cells(Rows.Count, 1).End(xlUp).Row For j = 12 To Sheets("資料").Cells(i, 12).End(xlToRight).Column For k = 2 To Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row If アイス(i, 3).Value = チョコ(k, 7).Value And アイス(i, j).Value = チョコ(k, 5).Value Then Sheets("資料").Range("A" & i & ":D" & i).Interior.ColorIndex = 22 アイス(i, j).Interior.ColorIndex = 22 End If Next k Next j Next i

  • エクセルVBA カウンタ2つを入れ子にしたくない時

    皆さんこんにちは。 エクセル2013を使用しております。 エクセルVBAの繰り返し処理について質問させていただきます。 下記のコードですと入れ子があるので A1にi、A3にi・・・・を一通り記載したあと またA1にi+2、A3にi+2・・・を繰り返し 最終的にA列には全て同じ値が入ってしまいます。 (Step 2にしたのはA1:A2のように2行毎の結合セルだからです) -----------------------------------------------------------------    Dim i As Long Dim j As long Dim n As long Dim k As long     i =Userform.textbox1.value     j =Userform.textbox2.value    For k =i To j Step 2 For n = 1 to j Step 2 Range("A" & n) = k    Range(”B”&n)=k+1        Next    Next ---------------------------------------------------------- もしiが1、jが10だとしたら A1に1、B1に2、A3に3、B3に4、・・・A9に9、B9に10 が入るようにするにはどうしたら良いでしょうか。 iが必ず1から始まるのであればまだ分かるのですが そうとも限らないので カウンタはやはり2つ必要だと思うのですが カウンタが2つあるのに入れ子にしないコードの書き方って あるのでしょうか。 いくら本やネットを見ても分かりません。 ご教授いただけると幸いです。

  • [VBA] 連想配列について

    こちらの識者の方々にはいつもお世話になっています。 VBAの質問です。 環境は下記になります。 OS=windowsXP SP3 Office=Excel2003(11.8347.8403) SP3 データ量が多いのでVLOOKUPの処理を連想配列を使ってやりたいのですが、できなくて困っています。 言葉では説明しずらいので、やりたいことのコードを提示します。 :Sheet2 品名  1月  2月 りんご 2   3 ばなな 4   5 下記、VBAコード ---------------------------------------------------- Option Explicit Sub test()  Dim oDict As Object  Dim Ary As Variant  Dim EndRow As Long  Dim i As Long  Ary = Sheets("Sheet2").Range("A2:C3").Value  Set oDict = CreateObject("Scripting.Dictionary")  For i = 1 To UBound(Ary)   oDict(Ary(i, 1)) = Ary(i, 2)   oDict(Ary(i, 2)) = Ary(i, 3)  Next i  With ThisWorkbook.Sheets("Sheet1")   EndRow = .Cells(Rows.Count, 1).End(xlUp).Row   Ary = .Range("A1:Y" & EndRow).Value   For i = 2 To EndRow    Ary(i, 24) = oDict(Ary(i, 1))    Ary(i, 25) = oDict(Ary(i, 2))   Next i   .Range("A1:Y" & EndRow) = Ary  End With  MsgBox "done" End Sub ---------------------------------------------------- というコードなのですが、  For i = 1 To UBound(Ary)   oDict(Ary(i, 1)) = Ary(i, 2)   oDict(Ary(i, 2)) = Ary(i, 3)  Next i が、oDict(Ary(i, 1)) = Ary(i, 2)だけ配列に格納される状態です。 指定の文字列(Key)に対応するItemを返すのが連想配列だと思うのですが、上記コードで、 oDict(Ary(1, 1))=2 oDict(Ary(2, 1))=4 oDict(Ary(1, 2))=3 oDict(Ary(2, 2))=5 という配列に格納されない理由がわかりません。 Scripting.Dictionaryで辞書に格納できるデータになにかしらの制限があるのでしょうか? 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。

  • VBA サンダーバードのメール自動作成

    いつもお世話になってます。 サンダーバードでメールを自動作成しようと思い、回答者さんのアドバイスで以下のコードを 作成しました。 【仕様】 sheet2のA列に、メールの宛先と本文の文字列が下方向に並んでおり、ループしながら宛先と本文を新規メールに送っていく。 Dim sPath As String Dim Mailad As String Dim Subjct As String Dim Bodyst As String Do Until Sheets("sheet2").Range("J" & cnt).Value = syuryono + 1 If Sheets("sheet2").Range("I" & cnt).Value = "アドレス" Then 'メルアドを取得 meruado = Sheets("sheet2").Range("A" & cnt).Value cnt = cnt + 1 'メルアドから下の行を本文として取得 honbun = "" Do honbun = honbun & Sheets("sheet2").Range("A" & cnt).Value honbun = honbun & "%0a" cnt = cnt + 1 Loop Until Sheets("sheet2").Range("I" & cnt - 1).Value = "エンド" '文字数カウント a = Len(honbun) 'メール作成 sPath = """C:\Program Files\Mozilla Thunderbird\thunderbird.exe"" -compose " Mailad = meruado Subjct = Sheets("説明").Range("A7").Value Bodyst = honbun Shell sPath & "to=" & Mailad & "," & _ "subject=""" & Subjct & """," & _ "body=""" & Bodyst & """" Else cnt = cnt + 1 End If Loop で、質問なんですが、 'メルアドから下の行を本文として取得 honbun = "" Do honbun = honbun & Sheets("sheet2").Range("A" & cnt).Value honbun = honbun & "%0a" cnt = cnt + 1 Loop Until Sheets("sheet2").Range("I" & cnt - 1).Value = "エンド" 上記の部分で本文を作っていくときに、本文中に「,」が入っていると、そこで本文が途切れてしまいます。 例えば、A2セルに「りんご」A3セルに「みかん」とある場合、変数honbunは「りんご%0aみかん」となり メール本文は「りんご(改行)みかん」となりますが、A2セルが「りんご」A3セルが「み,かん」の場合 メール本文が「りんご(改行)み」で終わってしまいます。 正規表現?的な文字が入っていると、メーラーのbodyに渡す時に途切れちゃうのかなという感じです。 変数honbunに入っている文字列はすべてただの文字列とし、上記の例の場合にメールが途中で 途切れないようにする方法はありますでしょうか?

専門家に質問してみよう