- ベストアンサー
高速な方法で１次元配列をワークシートに転記する方法
cafe_au_laitの回答
- cafe_au_lait
- ベストアンサー率51% (143/276)
まずは、「Next Num」の時点と「Next i」の時点での所要時間を出力してみてください。 こちらで試したところでは、セル転記にはほとんど時間がかかっていません。
関連するQ&A
- エクセル マクロ 範囲指定。
先日、ＯＫWAVEのサイトでエクセルマクロの質問をさせていただき 下記の回答を活用したいのでしが myKey = Worksheets("Sheet2").Range("A1").ValueをＡ１Ａ２・・・Ａ５０のように 50個を一度に処理したいのですがどのように変更すればよろしいのでしようか 自分なりに調べてみましたが知識がなくできませんでした ご回答のいただいたmitarashiさんにお聞きしたいのですがお聞きする手段がわからず 再度、質問させていただきます。 宜しくお願いいたします。 Sub test() Dim targetRange As Range Dim buf As Variant Dim i As Long, j As Long, myColorIndex As Long Dim myKey As Variant Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set targetRange = Worksheets("Sheet1").Range("J10:BB10000") buf = targetRange myColorIndex = 4 myKey = Worksheets("Sheet2").Range("A1").Value With targetRange For i = 1 To UBound(buf, 1) For j = 1 To UBound(buf, 2) If buf(i, j) = myKey Then .Cells(i, j).Interior.ColorIndex = myColorIndex Next j Next i End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
- 締切済み
- Visual Basic
- 二次元配列のVBA
二次元配列のVBAの書き方がよくわからないのですが、 私が作ったサンプルプログラムのSub 二次元()において 二次元配列で表すにはどうすればいいのでしょうか？ Sub 二次元()では 配列を格納する変数はtmpしか使っていませんが もう一つ配列を格納する用の変数を作ればいいのでしょうか？ 数字とアルファベットは別々に取り出したいです。 ----------------------------------------------------- Sub 一次元() Dim myStr As String Dim tmp As Variant Dim i As Long For i = 1 To 5 myStr = myStr & "," & i Next myStr = Mid(myStr, 2) tmp = Split(myStr, ",") For i = LBound(tmp) To UBound(tmp) Debug.Print tmp(i) Next i End Sub Sub 二次元() Dim myStr As String Dim tmp As Variant Dim i As Long For i = 1 To 5 myStr = myStr & "," & i & "と" & Chr(64 + i) Next myStr = Mid(myStr, 2) tmp = Split(myStr, ",") For i = LBound(tmp) To UBound(tmp) Debug.Print tmp(i) Next i End Sub
- ベストアンサー
- Excel（エクセル）
- VBA 複数のシートをまたいでの連想配列
win7、Excelは2013を使用しています。 添付画像の様に、12シートの合計を連想配列に格納しsheet13に書き出したいのですが、プロシージャーの下から6行目のところで、エラーコード451が出ます。 どの様に変更すれば良いか教えて下さい。 Sub 年間集計() Dim Dic Dim i As Integer Dim j As Integer Dim sh As Worksheet Dim rng As Range Dim buf As String Dim num As Integer Set Dic = CreateObject("Scripting.Dictionary") For Each sh In Worksheets For Each rng In sh.Range("J2", sh.Cells(Rows.Count, 10).End(xlUp)) buf = rng.Value num = rng.Offset(, 1).Value If Not Dic.Exists(buf) Then Dic.Add buf, num Else Dic.Item(buf) = Dic.Item(buf) + num End If Next rng Next sh j = 2 With Worksheets("Sheet13") For i = 0 To Dic.Count - 1 .Cells(j, 1) = Dic.Keys(i) ’エラー箇所 .Cells(j, 2) = Dic.Items(i) j = j + 1 Next i End With End Sub
- ベストアンサー
- Excel（エクセル）
- [VBA]二次元配列を使ったsumif
こちらの識者の方々にはいつもお世話になっています。 VBAの質問です。 環境は下記になります。 OS=windowsXP SP3 Office=Excel2003(11.8347.8403) SP3 vbaでワークシート関数でいうsumifにあたる計算をしたいのですが、自分なりに二次元配列でコードを書いたものの、それでも時間がかかりすぎるため質問させていただきます。 :Sheet1 4月 5月 6月 7月 りんご 20 10 31 みかん 50 40 20 バナナ 35 15 20 りんご 52 50 65 ぶどう 32 63 みかん 21 23 50 のようなデータが約40,000行存在します。 これをSheet2に 4月 5月 6月 7月 りんご 20 62 81 65 みかん 71 0 63 70 バナナ 35 15 20 0 ぶどう 0 0 32 63 のような形で集計したいのです。 自分で書いたコードは下記です。 Option Explicit Option Base 1 Sub test() Dim SourAry As Variant Dim DestAry As Variant Dim SourEndRow As Long Dim DestEndRow As Long Dim i As Long Dim j As Long Dim k As Long Dim TTL As Long Application.ScreenUpdating = False SourEndRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row DestEndRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row SourAry = Sheets("Sheet1").Range("A2:E" & SourEndRow).Value DestAry = Sheets("Sheet2").Range("A2:E" & DestEndRow).Value For i = 2 To 5 For j = 1 To UBound(DestAry) For k = 1 To UBound(SourAry) If SourAry(k, 1) = DestAry(j, 1) Then TTL = TTL + SourAry(k, i) DestAry(j, i) = TTL Next k TTL = 0 Next j Next i Sheets("Sheet2").Range("A2:E" & DestEndRow).Value = DestAry Application.ScreenUpdating = True End Sub これでも一応希望通りの結果は得られるのですが、40,000行ともなると配列で処理したとしてもとても時間がかかってしまいます。 ご教示いただきたいことは、もっと効率のいいコードなのですが、実は実際のデータはSheet1とSheet2のA列のデータは昇順で並んでおります。 後学のためにもしよろしければ下記2パターンを教えて戴けませんでしょうか。 1.キーとなるフィールドが昇順で並んでいる場合 2.キーとなるフィールドの順番がばらばらで、かつ並び替えることができない場合（A列総当たり） 2.のパターンの場合、コードによると思いますが、総当たりよりかはやはり並び替えた方が効率はいいものなのでしょうか？ 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- ExcelVBAの転記（1つのひな形へ複数シート）
お世話になります。ExcelVBAを少し学んだ程度の者です。 1つのExcelファイルに複数存在する個別のシートから、1つのひな形シートへ転記する方法に頭を悩ませております。イメージとしては名簿管理のようなものとご理解してください。 複数存在するシート（約200シート）には、項目名に対するデータ（例えば、名前や住所などが定められたセルに入力されています）が揃っておりますが、書式の変更によりひな形のシートへ転記する必要があります。 200ほどのシートには、M10セルには名前が、B15セルには住所、C16セルには電話番号が……という具合に入力されています。これらのデータをひな形シートでは、N5セルに名前、C13セルに住所、D14セルには電話番号などを転記する必要があります（セル番地は適当です）。 ひな形シートは1枚で、マクロを実行する際にひな形シートをコピーして（Xとします）、200ほどの個別のシート（A、B、C……）を転記しようと思っております。A、B、C……に入力された複数の値は項目別にCells(i,j).Valueを、XへCells(x,y).Valueへ転記すれば良いと考えておりましたが、上手くいきません。ひな形をコピーしたXのシートへ上手く転記ができず、Aを転記したシートばかりが量産され、B、C以降のシートへ制御が移っていないようです。恐らく、Workwsheetオブジェクトのカウンタ変数に問題があると思われます。 VBAのコードとしては下記のように記述しております。 Sub SheetCopy() Application.ScreenUpdating = False Dim cnt As Long 'シート数カウント変数 Dim i As Long 'シート用のカウンタ変数 Dim wb As Workbook 'コピー元 Dim ws1 As Worksheet 'コピー元 Dim ws2 As Worksheet 'コピー先 '1がコピー元で2がコピー先 cnt = Worksheets.Count 'シート数をカウント i = 2 Set wb = Workbooks("転記用.xlsm") Set ws1 = wb.Worksheets(i) Set ws2 = wb.Worksheets("ひな形") For i = 1 To cnt ws2.Copy after:=Worksheets(i) Set ws2 = wb.Worksheets(i) ws2.Cells(2, 2).Value = ws1.Cells(2, 13).Value '名前 ws2.Cells(3, 2).Value = ws1.Cells(6, 10).Value '住所 以下、同様の転記処理を記述しています。 Next i End Sub 上記のコードを、パッと見たところ、コピーはしているものの、転記先がコピー元になっているのも原因だと思います（コピー先へ転記する方法が現時点でわかりかねます……ここがネックだと考えております）。 ご知見のある方々から、アドバイスをいただけると幸いです。 どうぞ、よろしくお願い申し上げます。
- ベストアンサー
- Excel（エクセル）
- 図形のクリアで実行時の1004エラーになる
指定範囲(I9:CW40)から図形(円・四角形)のクリアをするとエラーになってしまいます。終了をすればクリアはできるのですが。御教授願えませんでしようか？(尚四角形はセルの枠線上に貼り付けるようにしてあります。) Sub 図形のクリア() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim myRng As Range Dim sp As Variant Set myRng = Range("I9:CW40") For Each sp In ActiveSheet.Shapes If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing Then sp.Delete (ここで実行時1004のエラーになる。) End If Next Set myRng = Nothing Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
- ベストアンサー
- Visual Basic
- 図形のクリアができない。
指定範囲(I9:CW40)から図形(円・四角形)のクリアをするとエラーになってしまいます。御教授願えませんでしようか？(尚四角形はセルの枠線上に貼り付けるようにしてあります。) Sub 図形のクリア() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim myRng As Range Set myRng = Range("I9:CW40") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing Then(ここで、1004の実行エラーになる。) sp.Delete End If Next Set myRng = Nothing Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
- ベストアンサー
- Visual Basic
- VB.NET 2次元配列
二次元配列に関して質問があります。 二次元配列を定義します。 Dim a(,) As Integer = _ {{0, 0, 0, 0, 0, 0, 1, 1, 1}, _ {0, 0, 0, 0, 0, 1, 0, 0, 1}, _ {0, 0, 0, 0, 0, 0, 1, 1, 1}} 一次元配列を定義します。 Dim b() As Integer 一次元配列のb()に二次元配列a(,)の {0, 0, 0, 0, 0, 0, 1, 1, 1}の部分を 入れようとした場合、 どのように記載すればよろしいでしょうか？ イメージ的には b = a(0) で出きると思ったのですが、 構文エラーとなってしまいます。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- 配列に格納したデータを指定行以下に転記する方法
excel2000を使っています。 以下のコードだと最終行にデータが転記されます。これを４行目に確定して、転記したいのです。常に４行目つまりＡ列４行目以下に上書きしたいのです。 その場合コードをどのように変更すべきでしょうか？ Sub 配列() With ActiveSheet ' 配列に格納 --------------------------- Dim i As Integer Dim LastRow As Long Dim SaleAry As Variant ' 配列に格納 --------------------------- SaleAry = Array(.Range("t4"), .Range("e5"), .Range("ｇ5"), .Range("o5")) End With ' 転記 --------------------------- With Worksheets("daityou") LastRow = .Range("A65536").End(xlUp).Row For i = 0 To UBound(SaleAry) .Cells(LastRow + 1, i + 1).Value = SaleAry(i) ' Next i End With Set SaleAry = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- VBA：日付を配列に入れ別セルに転記するとデータ型が変わる
データを別シートに転記するVBAコードを書いていて気付きました。 日付データをバリアント型の配列に入れて、再度書き出すと 21/2/2005 のように表示され、さらに日付ではなく、文字列になってしまいました。 具体的には下記のような内容です。Sheet1 の A1:A10 に 2005/2/21 のような日付が入力されています。 1. セル範囲のデータをバリアント型の配列に格納 2. 1.を別のセルへ一括転記を行う Sub TestMacro() Dim Buf As Variant With Sheets("Sheet1").Range("A1:A10") Buf = .Value '・・・(1) .Offset(0, 3) = Buf '・・・(2) End With End Sub ウォッチ式で変数を確認すると(1)および(2)の時点では #05/02/21# Variant/Date型 と正しく日付として扱われているようです。しかし、転記されたセルを見てみると、「文字列で 21/2/2005 」となっているのです。 2005/2/21 が返されるものと思うのですが、なぜ、このような現象が起こるのでしょうか？何かとんでもない勘違いをしているのでしょうか？ テスト環境は Win98SE ＋ EXCEL2002 です。よろしくお願いします。
- ベストアンサー
- Visual Basic
お礼
ありがとうございます。 問題は転記時間ではなかったのですね。