質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

3回答

1626閲覧

別々のシートからセル範囲をコピーして、一旦配列に格納。格納したデータを一つのシートへ一括で貼り付けしたい。

sadaharu

総合スコア13

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

2クリップ

投稿2019/05/29 21:48

編集2019/06/01 23:18

イメージ説明
イメージ説明

VBAにて高速処理ができないか悩んでいます。

処理内容は
1.検索ワードを入力
検索ワードは同じ行の場合はAND条件、
異なる行の場合はOR条件です。
画像では「ぶっかけ AND 九州」 or「ハヤシライス」となります。
2.日付ごとに並んだシート(リストが作成されている)を検索し、条件に合致する行(2行で1項目)をコピー
3.検索ワードが入力されているシートに検索結果を貼り付けする
処理を行っています。

一番上の画像が検索結果を表示するシート、二番目の画像がデータイメージです。

プログラム自体は作動しますが、各シートごとに検索結果をコピーし、都度貼り付けをしている(ソースコードを##################で囲んだ部分です。)ため、処理に時間がかかっています。

実際、#####で囲んだ部分をコメントアウトして実行すると処理速度が劇的に速くなります。
(通常は40秒かかり、#######で囲んだ部分をコメントアウトして実行した場合は、5秒で処理が終了しました。
1シート当り:約20件のデータ
シート数:400シート
170件ヒットした場合です。)

そのため、配列に格納するすれば高速処理が可能になるのではと思い、考えましたがどうすればよいのかわかりません。

アドバイスください。

Sub 検索用() Application.ScreenUpdating = False With ThisWorkbook.Sheets("検索") Dim i As Long '検索結果始まりタイトル行 Dim kiten As Range Set kiten = .Range("A14") '以前の検索結果を削除 kiten.CurrentRegion.UnMerge kiten.CurrentRegion.Offset(1).Interior.ColorIndex = xlNone kiten.CurrentRegion.Offset(1).ClearComments kiten.CurrentRegion.Offset(1).ClearContents '検索候補が1行だった場合、配列ubound lboundがエラーとなるため '2行にする措置 Dim flag As Boolean If .Cells(5, "C").Value = "" Then .Cells(5, "C").Value = "................" flag = True End If '検索シートの右側が検索対象 Dim j As Long Dim arrayShname() As String Dim sh As Variant ReDim arrayShname(0) For Each sh In ThisWorkbook.Sheets If sh.Index > .Index Then ReDim Preserve arrayShname(j) arrayShname(j) = sh.Name j = j + 1 End If Next End With Dim key As Variant Dim bkey As Variant '検索ワードを配列へ格納 key = ThisWorkbook.Sheets("検索").Range("C4").CurrentRegion.Value '検索ワード空白だったら終了 If IsEmpty(key) Then Exit Sub End If ''検索結果始まり行 Dim k As Long k = 15 'bによりkeyの一次元配列数(検索行数)をカウント=検索行ごとに検索していく Dim b As Long For b = LBound(key, 1) To UBound(key, 1) bkey = Split(Replace(Application.WorksheetFunction.Trim(key(b, 1)), " ", " "), " ") 'シート配列から検索していく Dim p As Long For p = 0 To j - 1 Dim iii As Long Dim tmpSheet As Worksheet Dim endRow As Long Set tmpSheet = ThisWorkbook.Sheets(arrayShname(p)) endRow = tmpSheet.Cells(Rows.Count, "V").End(xlUp).Row For i = 7 To endRow Step 2 Dim HHH As Integer Dim c As Range With tmpSheet.Rows(i & ":" & i + 1) For HHH = LBound(bkey) To UBound(bkey) Set c = .Find(What:=bkey(HHH), matchbyte:=False, _ LookIn:=xlValues, LookAt:=xlPart) '---(1) '条件に当てはまるセルがあるかどうかを判定 If c Is Nothing Then GoTo TTT End If Next HHH '繰返し検索し、条件を満たす行を検索する '######################## この部分の処理で時間がかかっている tmpSheet.Rows(i & ":" & i + 1).Copy _ ThisWorkbook.Sheets("検索").Rows(k) '######################### k = k + 2 End With TTT: Next i Next p Next b If flag Then ThisWorkbook.Sheets("検索").Cells(5, "C").ClearContents End If Application.ScreenUpdating = True End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ttyp03

2019/05/30 01:56

本当に###のところだけがネックなのでしょうか? この部分をコメントアウトして時間計測してみましたか? (どこがとは言えませんが)プログラム全体を見渡してみるとなんとなく無駄が多いような気がしています。 気がする、というだけで必要な処理なのかもしれませんが。。。
hatena19

2019/05/30 22:50

コードの修正ありがとうございました。コードだけだとやりたいことの把握が難しいので、元のデータ例、抽出後のデータも提示してもらえると、適切な回答がつきやすいと思います。
hatena19

2019/06/01 11:23

画像データですか、実データではないですよね。名前とか、携帯番号とか、、、。 メールアドレスはサンプルデータのようですが。
hatena19

2019/06/01 11:47

とりあえず ### のところのコードを私の回答の「追記2」のコードに変更して試してくれませんか。
sadaharu

2019/06/01 12:01

hatena19様 データはランダムに作成されたものなので架空のものですが、一応変更しておきます。 作成してくださった「追記2」と「追記3」を試してみました。 「追記2」でも十分満足の行く速度でした! 配列を使用してのコードの書き方がいまいち分からなかったため、「追記3」を作成していただいて助かりました。 勉強していきます。
hatena19

2019/06/01 12:09

最初のコードの一番のネックは、行全体をコピーしている部分だったと思われます。 16384列のデータをコピーすることになりますからね。
guest

回答3

0

Excel

1Sub test() 2 Dim wsSEarch As Worksheet: Set wsSEarch = ThisWorkbook.Worksheets("検索") 3 Dim rngToSearch As Range: Set rngToSearch = wsSEarch.Range("C4").CurrentRegion 4 Dim rngForSearch As Range 5 Dim rngTarget As Range 6 Dim rngFind As Range 7 Dim c As Range 8 Dim c2 As Range 9 Dim ws As Worksheet 10 Dim ss As Variant 11 Dim s As Variant 12 Dim ixRow As Long 13 Dim ixMax As Long 14 Dim ixResult As Long 15 Dim i As Long 16 Dim flg As Boolean 17 18 If IsEmpty(rngToSearch(1).Value) Then Exit Sub 19 rngToSearch.Replace " ", " " 20 21 For Each c In rngToSearch 22 For Each ws In ThisWorkbook.Worksheets 23 If ws.Index > wsSEarch.Index Then 24 ixRow = 1 25 Set rngForSearch = ws.UsedRange 26 ixMax = rngForSearch.Rows.Count 27 28 Do Until ixRow > ixMax 29 ss = Split(c.Value, " ") 30 Set rngTarget = rngForSearch.Find(s(0), rngForSearch(rngForSearch.Cells.Count), , xlPart) 31 If rngTarget Is Nothing Then Exit Do 32 Set rngTarget = Application.Range(rngForSearch.Rows(Int(rngTarget.Row) / 2) * 2, rngForSearch.Rows(ixMax)) 33 34 For Each s In ss 35 flg = False 36 For Each c2 In rngTarget 37 If InStr(1, c2.Value, s) > 0 Then 38 flg = True 39 Exit For 40 End If 41 Next 42 If flg = False Then Exit For 43 Next 44 45 If flg Then 46 rngTarget.Copy wsSEarch.Cells(ixResult, 1) 47 ixResult = ixResult + 2 48 ixRow = ixRow + 2 49 Set rngForSearch = Application.Range(rngForSearch.Rows(ixRow), rngForSearch.Rows(ixMax)) 50 End If 51 Loop 52 53 End If 54 Next 55 Next 56End Sub

行き当たりばったりで書きました。
配列とか配列変数とかは出来る限り使ってません。
まずはロジック(?)の整理かと思いましたので。。。
コンパイルはしましたが動作確認はしてません。
コピペで時間が掛かるなら、コピペの回数を減らす方向で考え直したいと思います。

1シート当り何件くらいデータがあって、
何個シートがあって、
何件ヒットしたときに40秒かかるのですか?

あと、配列がどうのという前に、
1行に1件のデータという風に整形したほうが検索しやすいかもですね。
元のデーター数が多くて、ヒットするデータ数も多いなら、
エクセルで処理するのはもしかして辛いのかなぁ。。。。

参考になれば。。。

投稿2019/05/31 13:48

mattuwan

総合スコア2136

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

sadaharu

2019/06/01 11:04

mattuwan様  サンプルコードの作成ありがとうございます! ここまできれいなコードを書くことができるのですね。 そのままコピペして実行しようとしましたが、 「Set rngTarget = rngForSearch.Find(s(0), rngForSearch(rngForSearch.Cells.Count), , xlPart)」や 「Set rngTarget = Application.Range(rngForSearch.Rows(Int(rngTarget.Row) / 2) * 2, rngForSearch.Rows(ixMax))」 付近でエラーになってしまいました。 レベルが違いすぎて、よく理解しきれていませんが、正常に動作するようにやってみたいと思います。 ちなみに、処理に40秒かかるのは、 1シート当り:約20件のデータ シート数:400シート 170件ヒットした場合です。
mattuwan

2019/06/01 13:38 編集

画像見ましたが、2行で1件は必須でしょうか? エクセル的には1行1件の方が処理しやすい(コードが簡単になる)ので、 中間処理として1行1件に整形した方がよいように思います。 また、データ数も少ない(20件×400個=8000件)ので、 1つのシートに纏めた方が作業はやりやすいし、コードのメンテナンスも後々楽かなぁという印象です。 いずれにしても、各作業をサブルーチンに追い出すと考える方も楽ですし、 コードのメンテナンスも楽かとは思います。 あと、検索語もすべてOr条件なのですね? (あれか、それか、これかのいずれかに該当すればHitとする) その辺の条件も日本語で明確に説明された方がよいかと思います。 (他人が書いたコードを読むのは流儀がそれぞれあり結構困難な作業なので。。。) あと、不要な空白行はスクロールを強要し作業効率が悪いかと思いました。 作業ブロックの分けを表現する程度にした方が、個人的に好みです。 インデントも含めて、1年後の自分が読めるような書き方を覚えてください。 エクセル的には、 フィルターオプションという機能を使えるように、 データを整形したら、 検索(抽出)部分のコードが恐ろしく簡便になりますので、 そちらの機能を使えるようになられるといいかと思います。 いずれにしても工夫次第でどうにでもなるのはなるのですが。。。 高速化については、 ループの回数を減らす(出来ればVBAでループ処理を書かずにエクセルに任せる)、 対象のセル範囲を必要最小限にする、 に注意すれば、配列変数に一旦データを書き出すより速い場合もあります。 (フィルタオプションは意外と遅かったですが^^;何より遅いかは忘れましたが^^;;) あと、一般的に個々のセルの読み書きは以外と時間が掛かります、 そういう場合は、配列変数を使うなどしてセルの読み書きの回数を減らすと劇的に処理速度が改善するかと思います。
mattuwan

2019/06/01 13:44

ああ、コードの方はエラーが出たようでごめんなさいです。 テストデータをつくるのが億劫なので(前提条件も解り難かったし)、ちょっとデバッグする元気はありません。すみません。 こちらが、時間があればいいのですが、ちょっと難しいです。 気が向けば、気分転換に再チャレンジするかも知れませんが、期待はしないでください。
sadaharu

2019/06/01 23:23

mattuwan様 >画像見ましたが、2行で1件は必須でしょうか? 必須です。 確かに1行1件がメンテナンスも容易なのは重々認識しているのですが、他の人間も共同で使っており、 2行で1件でしか折り合いがつかない状況なのです。 >あと、検索語もすべてOr条件なのですね? >(あれか、それか、これかのいずれかに該当すればHitとする) 検索語は同じ行の場合はAND条件、 異なる行の場合はOR条件です。 画像では「ぶっかけ AND 九州」 or「ハヤシライス」となります。 >あと、不要な空白行はスクロールを強要し作業効率が悪いかと思いました。 >作業ブロックの分けを表現する程度にした方が、個人的に好みです。 >インデントも含めて、1年後の自分が読めるような書き方を覚えてください。 その他いろいろと改善のアドバイスありがとうございます。 万人にとって見やすいコードを作成していくようにしていきたいと思います。
guest

0

ベストアンサー

時間がかかるのは、###のところがネックというより、
Findで検索して、1データずつ処理していることだと思います。
Find自体、重い処理です。

配列を使って高速化することはできますが、全面的にコードを書き直す必要があります。

そのまえに、やることはいろいろあります。
Findはやめて、AutoFilter で絞り込んだ結果をコピーするというロジックに書きなおすと、
かなり改善できると思います。

追記1

2行で1項目ということなので、AutoFilter を使うなら、作業列を使う方法になるかな。

  1. 作業列の奇数行に、条件に一致するなら、〇 を出力する式を設定。
  2. 偶数行は、上の列を参照する式にする。
  3. AutoFilter で作業列の〇の行を絞り込む。
  4. これの作業列を除いた列をコピーする。
  5. 作業列をクリアする。

これで、コピーは1回ですむのでかなり高速化はできると思います。

配列を使う場合は、
セルをひとつづつ参照するのが時間がかかるので、セルへのアクセスをなるべく減らす。
配列上で処理をして、結果を一気にレンジに代入する。
という方針で作成すると高速化できます。

  1. 検索対象範囲を一気に配列に格納する。
  2. 配列をループして条件に一致する行と次の行を結果配列に追加していく。
  3. 結果配列をレンジに代入する。

追記2

実際、#####で囲んだ部分をコメントアウトして実行すると処理速度が劇的に速くなります。
(通常は40秒かかり、#######で囲んだ部分をコメントアウトして実行した場合は、5秒で処理が終了)

質問に上記が追記れさているのに気が付きました。
コピーが値だけでいいなら(書式は無視)、Value の代入にすると改善されるかも。

vba

1ThisWorkbook.Sheets("検索").Range("A" & k).Resize(2,23).Value _ 2 = tmpSheet.Range("A" & i).Resize(2,23).Value

アップされた画像をみるとひとつのデータ範囲は、2行×23列のようですので、それに合わせて変更しました。

追記3

追記1 の後者の配列を使う場合のロジックのコード例

検索範囲固定、キーワード固定、検索列1行目 のシンプルなモデルでのコード例ですので、
ロジックを理解して、実際のものに応用してください。

vba

1Public Sub test() 2 Dim f() As Variant 3 f = Worksheets(1).Range("A1").Resize(100, 5).Value '検索範囲を配列に格納 4 5 Dim r() As Variant 6 ReDim r(1 To UBound(f), 1 To UBound(f, 2)) '検索結果格納用配列 7 8 9 Dim KeyWord As String 10 KeyWord = "xxx" '検索キーワード 11 12 Dim i As Long, rcnt As Long, j As Long 13 rcnt = 0 14 15 For i = 1 To UBound(f) Step 2 16 If InStr(f(i, 1), KeyWord) > 0 Then '部分一致したら 17 '検索結果配列に格納 18 For j = 0 To 1 '2行分 19 rcnt = rcnt + 1 20 r(rcnt, 1) = f(i + j, 1) 21 r(rcnt, 2) = f(i + j, 2) 22 r(rcnt, 3) = f(i + j, 3) 23 r(rcnt, 4) = f(i + j, 4) 24 r(rcnt, 5) = f(i + j, 5) 25 Next 26 End If 27 Next 28 29 Worksheets(2).Range("A1").Resize(rcnt, 5).Value = r '検索結果配列をセル範囲に代入 30 31End Sub

処理のネックとなるセルへのアクセスは、検索範囲を配列に格納と、検索結果配列の代入の2回だけで、
あとは、メモリ上の操作になりますので、高速化します。

投稿2019/05/30 05:05

編集2019/06/01 11:46
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

TanakaHiroaki

2019/05/30 12:49

hatena19さん Findの検索がネックで、配列で高速化する前に、ソートやフィルターなどの改善策もあると直感しましたが、うまく表現できませんでした。 私が漠然と感じたことを具体的に表現した回答をされており、大変感服いたしました。
sadaharu

2019/05/30 21:48

hatena19様 アドバイスありがとうございます。 当初はAutofilterでの絞り込みを考えましたが、リストが「2行で1項目」で構成されており、Autofilterや並び替え等の機能を使用することができません。 いわば、リストとしての体裁が整っていないシートから検索をせざるを得ない状況です。 そのため、現在のコードのようにFindを使用し、検索範囲をリストの2行ごとに区切り、都度検索をしていく方法を取りました。 目的は高速化したいだけなので、配列にこだわっているわけではありません。 無駄の多い見づらいコードを掲載して申し訳ありませんが、なにかアイデアをいただけると助かります。
h.horikoshi

2019/05/31 01:32

チェックするセルの列(カラム)位置やセルの属性が固定なら、 Findを使うより自前でセルの値を比較していったほうが速い ような気がしますが、それらは固定ではないのでしょうか?
guest

0

手っ取り早く対応を方針に、現状ネックになっているところだけをどうにか改善できないかいくつか試してみました。
1000回コピーするという処理の時間計測です。
結論としては現状行全体をコピーしてるのをやめて、列数を限定すると大幅に改善しました。
配列を使うのは逆に遅くなりました(やり方が悪い?)

VBA

1 Debug.Print "現状" 2 k = 1 3 Debug.Print Now() 4 For n = 1 To 1000 5 tmpSheet.Rows(i & ":" & i + 1).Copy _ 6 ThisWorkbook.Sheets("検索").Rows(k) 7 Next 8 Debug.Print Now() 9 DoEvents 10 11 Debug.Print "配列使用" 12 k = 3 13 Debug.Print Now() 14 For n = 1 To 1000 15 tmp = tmpSheet.Rows(i & ":" & i + 1) 16 ThisWorkbook.Sheets("検索").Rows(k & ":" & k + 1) = tmp 17 Next 18 Debug.Print Now() 19 DoEvents 20 21 Debug.Print "値だけコピペ" 22 k = 5 23 Debug.Print Now() 24 For n = 1 To 1000 25 tmpSheet.Rows(i & ":" & i + 1).Copy 26 ThisWorkbook.Sheets("検索").Rows(k).PasteSpecial xlPasteValues 27 Next 28 Debug.Print Now() 29 DoEvents 30 31 Debug.Print "列数を限定&値だけコピペ" 32 k = 7 33 Debug.Print Now() 34 For n = 1 To 1000 35 tmpSheet.Range("A" & i & ":Z" & i + 1).Copy 36 ThisWorkbook.Sheets("検索").Cells(k, 1).PasteSpecial xlPasteValues 37 Next 38 Debug.Print Now() 39 DoEvents 40 41現状 422019/05/31 10:52:23 432019/05/31 10:52:30 44配列使用 452019/05/31 10:52:31 462019/05/31 10:52:47 47値だけコピペ 482019/05/31 10:52:47 492019/05/31 10:52:52 50列数を限定&値だけコピペ 512019/05/31 10:52:52 522019/05/31 10:52:54

投稿2019/05/31 01:57

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hatena19

2019/05/31 02:47

原因は行全体をコピーしていることでしょうね。 配列も行全体を配列にいれたら、巨大な配列になるので、そりゃ遅くなります。 もし、時間があるなら、私の回答の「追記2」のValueで代入するコードも試してもらえませんか。
hatena19

2019/05/31 02:52

あと、配列を使うなら、 1回ずつ代入するのではなく、 検索結果を動的配列に追加していって、セル範囲への代入は1回で済ませるようしないとあまり意味はないです。
ttyp03

2019/05/31 03:04

>巨大な配列 そりゃそうですね。忘れてました。 >1回ずつ代入するのではなく 一応まとめてやってるつもりです。 >私の回答の「追記2」 やってみました。 現状 2019/05/31 12:01:04 2019/05/31 12:01:15 配列使用 2019/05/31 12:01:17 2019/05/31 12:01:32 値だけコピペ 2019/05/31 12:01:32 2019/05/31 12:01:38 列数を限定&値だけコピペ 2019/05/31 12:01:38 2019/05/31 12:01:40 hatena19氏案 2019/05/31 12:01:41 2019/05/31 12:01:41 hatena19氏の圧勝でした。おめでとうございます! 余談ですが、RowsでResizeは使えなかったのでRangeに変更しました。 あとResizeの範囲は(2,26)にしました(他と条件をそろえるため)
hatena19

2019/05/31 04:27

> Rangeに変更しました。 あっ、修正忘れですね。回答のほう、修正しました。 >>1回ずつ代入するのではなく > 一応まとめてやってるつもりです。 1000回代入してますよね。 検索結果が1000件なら、1000回代入するのではなく、1000行の配列を一回代入するようなコードにした方かいいという意味です。
ttyp03

2019/05/31 06:37

>1000回代入してますよね。 いや1000回処理するのを計測しているだけです。
hatena19

2019/05/31 07:44

高速化の手段としては、1000件の検索結果をコピーする場合、copyメソッドだと1000回実行する必要がありますが、配列を使用して1回で済ますという方法があるということを言いたかったのですが。
ttyp03

2019/05/31 07:48

回答にも書いていますが、あくまでも現状ネックになっている部分(#####のところ)だけを修正していかに改善できるかを調査したものです。 (大規模改造は質問者さまが望んでいないようですので)
hatena19

2019/05/31 07:52

そういうことなら了解です。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問