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

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

ただいまの
回答率

90.12%

データが多いと固まってしまうFor文を軽くしたい

解決済

回答 6

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 886

lq_hm_165912

score 12

以下のコードが行数が多くなると固まってしまいます。
(10万行ほど)

構成シートのA列と、集計画面のJ列が一致したら、集計画面のT列に構成シートのC列を出力したいのです。
この構成シートのA列にあたる部分が固定されている他のマクロでは上手く動きましたが、今回は変動有のリストなので最終行まで見ようとしています。

※最初の変動がないリストに関しては無事動作しました

Sub 構成反映2()


    Dim Sh1, Sh2 As Worksheet
    Dim rM, rH, rMy, rFirst, rU As Range

    Set Sh1 = ThisWorkbook.Worksheets("集計画面")
    Set Sh2 = ThisWorkbook.Worksheets("構成")

    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    '最終行の取得
    Dim lastrow As Long
    Dim lastrow2 As Long
    lastrow = Sh1.Cells(Rows.Count, 10).End(xlUp).Row
    lastrow2 = Sh2.Cells(Rows.Count, 1).End(xlUp).Row

    '検索
    For Each rM In Sh2.Range("A2:A" & lastrow2)
        Set rH = Sh1.Range("J2:J" & lastrow)
        Set rMy = rH.Find(What:=rM.Value)

        If rMy Is Nothing Then
            Exit For
        Else
            Set rFirst = rMy
            rMy.Offset(, 10).Value = rM.Offset(, 2).Value
        End If
        Do
            Set rMy = rH.FindNext(rMy)
            If rMy.Address = rFirst.Address Then
                Exit Do
            Else
                rMy.Offset(, 10).Value = rM.Offset(, 2).Value
            End If
        Loop
    Next


    Sh1.Range("T1").Value = "構成"

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub

↓Esc押せば結果がなぜか出てくるコードはこちら↓

Sub 構成反映()
    Dim Sh1, Sh2 As Worksheet
    Set Sh1 = ThisWorkbook.Worksheets("集計画面")
    Set Sh2 = ThisWorkbook.Worksheets("材料構成")    
 '------最終行の取得

    Dim lastrow As Long
    lastrow = Sh2.Cells(Rows.Count, "A").End(xlUp).Row

    Dim prefRng, cityRng As Range
    Set prefRng = Range(Sh2.Cells(2, 1), Sh2.Cells(40000, 1))

    Dim workEndR, workTmpR As Long, tmpStr As String
    workEndR = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

    Dim x As Long
    Application.ScreenUpdating = False

    For x = 0 To workEndR
        For workTmpR = 2 To workEndR
            tmpStr = Sh1.Cells(workTmpR, 10).Value
            On Error Resume Next
            Sh1.Cells(workTmpR, 20).Value = Sh2.Cells(Application.WorksheetFunction.Match(tmpStr, prefRng, 0) + 1, 3)
        Next
    Next    
    Sh1.Range("T1").Value = "構成"

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • lq_hm_165912

    2019/02/26 15:00

    空白やエラー値はありません。教えていただいた方法でもう少し頑張ってみます。

    キャンセル

  • coco_bauer

    2019/02/26 15:12

    「最初の変動がないリストに関しては無事動作しました」と書いてあるという事は、「変動有のリスト」では動作しない(無事には終わらない?)などの問題があるのですよね? 何が問題なのですか???

    キャンセル

  • lq_hm_165912

    2019/02/26 15:22

    95列固定の場合だと値が入力されてましたが、提示しているマクロだと入力されずに終わってしまいます。

    キャンセル

回答 6

+1

固まるのを防止したい目的(速さは二の次)であるのなら、ループ内にDoEventsを入れてください。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

+1

直接的ではないのですがパフォーマンスに影響することもある気になった箇所がありますので、余談と捉えていただいて結構です。

    Dim Sh1, Sh2 As Worksheet
    Dim rM, rH, rMy, rFirst, rU As Range

この型宣言部分ですが、このように書くと、

  • Sh2 は Worksheet型
  • rU は Range型
  • その他は Variant型

と宣言したことになります。

    Dim Sh1 As Worksheet, Sh2 As Worksheet
    Dim rM As Range, rH As Range, rMy As Range, rFirst As Range, rU As Range

とすることで各変数が意図したデータ型として宣言したことになります。


本題、構造的に2重ループになっている上に何度も検索をかけるような状態なので、検索対象行が増えれば増えるほどどんどん重くなる構造になっていますね。
質問文中、行と列が混乱しているように読めるためデータリストの構造が今一つ理解できていませんが検索をかける回数を減らすような構造にするとよいかと思います。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/26 14:29

    vlookup関数で済むような動作に見えるんですが、違いますか?

    キャンセル

  • 2019/02/26 15:49

    10万行ほどあるand他はマクロで動かせているのですべてマクロで行いたいと思っています。

    キャンセル

  • 2019/02/26 16:14

    分量的にも処理的にも、Excel というよりデータベースでやるような処理っぽいですね。
    Excelのバージョンにもよりますが、最新のExcelではvlookupなどのデータの扱いが強化されているらしいので、マクロ内でデータを取得するのではなく、計算式を入れるマクロにする方法もありそうです。
    https://claccico.com/excel-2019/

    また、Excel VBA から、シートのデータをSQL(のJOIN)を使って扱う方法があるのでそういう方法を考えたほうがいいようにも思います。
    例) https://lil.la/technology/post-2133

    キャンセル

+1

Sub 構成反映3()
    Dim rngKey As Range
    Dim rngList As Range


    With ThisWorkbook.Worksheets("集計画面").Range("A1").CurrentRegion
        Set rngKey = Intersect(.Cells, .Offset(1), .Columns("J"))
    End With

    With ThisWorkbook.Worksheets("構成")
        Set rngList = .Range("A1").CurrentRegion
        .Range("T1").Value = "構成"
    End With

    With rngKey.Offset(, 2)
        .Formula = "=VLookup(A2," & rngList.Address(, , , True) & ",10)"
        .Value = .Value
    End With
End Sub

セルの位置関係が分かってないけど、
なんとなくこんな感じで高速化できませんか?(動作確認はしていません。)

VBAで出来るだけループをしないように書くこと(=エクセル君が得意なことはエクセル君に任せる)が、
高速化につながると思います。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/28 19:26

    >これでうまくいきました!

    ↑だけでなく、どの程度のデータ量(集計画面シートと構成シートで、それぞれ何列×何行)で、
    改善前と後でどれくらい処理時間が短縮されたか、書いてもらえたらありがたいです。
    他に見ている人の参考にもなりますし、過去ログを探る人も居るでしょう。僕も知りたいです。
    せっかくの場所なので、皆で情報を共有しましょうよ^^

    キャンセル

  • 2019/03/01 12:59

    Sub 構成反映()
    Dim rngKey As Range
    Dim rngList As Range

    With ThisWorkbook.Worksheets("集計画面").Range("A2").CurrentRegion
    Set rngKey = Intersect(.Cells, .Offset(1), .Columns("J"))
    .Range("T1").Value = "構成"
    End With

    With ThisWorkbook.Worksheets("構成")
    Set rngList = .Range("A2").CurrentRegion
    End With

    With rngKey.Offset(, 10)
    .Formula = "=VLookup(J2," & rngList.Address(, , , True) & ",3)"
    .Value = .Value
    End With

    End Sub
    ↑しかも間違えていましたすみません。
    データ量は変動するのですが、構成シート3列×30000行・集計画面シートは23列×5000~30000行です。
    処理時間が短縮というか、改善前は処理が終わらずにEscで無理やり終わらせていた(でも出力はしていた)ので処理速度の比較は出来ませんが、集計画面シート3000行でしたら1秒もかからずに出力出来ました。

    キャンセル

  • 2019/03/01 18:25

    了解です。普段、個人的に200行ぐらいしか使うことがないので、何万行になったときにどうなるか知りたかったです。
    ありがとうございます。
    何万行とか超えたら(細かい数字は失念しました^^;)、
    Value = Value
    より、コピペの方が速いという噂もあります。
    もし運用して、気になったら試してみる価値があるかも知れません。

    キャンセル

check解決した方法

0

Sub 構成反映()

    Dim Sh1 As Worksheet, Sh2 As Worksheet
    Dim tate As Long
    Dim rH As Range
    Dim st() As String

    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Set Sh1 = ThisWorkbook.Worksheets("集計画面")
    Set Sh2 = ThisWorkbook.Worksheets("構成")

    '最終行の取得
    Dim lastrow As Long
    Dim lastrow2 As Long
    lastrow = Sh1.Cells(Rows.Count, 4).End(xlUp).Row
    lastrow2 = Sh2.Cells(Rows.Count, 1).End(xlUp).Row

    '検索
    For tate = 0 To lastrow2
        ReDim Preserve st(tate)
        st(tate) = Sh2.Range("A2").Offset(tate).Value
    Next

    For tate = 0 To UBound(st)
        For Each rH In Sh1.Range("J2:J" & lastrow)
            If rH.Value = st(tate) Then
                rH.Offset(, 10).Value = Sh2.Range("C2").Offset(tate).Value
            End If
        Next
    Next

    Sh1.Range("T1").Value = "構成"

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub

重いのでおそらくまだまだの出来だとは思いますが動きましたので解決にします。
参考URLなど勉強になりました。ありがとうございます。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

下記、ご参考ください。

つまり、forが一番時間がかかるというわけですね。
検査する列が決まっているならFindとかSearchとかの方が速いと思います。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/26 11:17

    例にあげた分は上手くできましたが、リストもlastrowで検索するときに上手く動かないので頑張ってみます

    キャンセル

  • 2019/02/26 11:20

    場合によってはデータの置き方も「集計しやすいように」工夫する必要があるかもしれませんね。

    キャンセル

  • 2019/02/26 11:24

    リスト自体が、重複を削除したものとしているので変動ありなのです。
    今のところFor文だと上手く動きます(固まりかけます)が、揉んでみます。参考になりました。

    キャンセル

  • 2019/02/26 15:45

    上手く動かない時には何が起きているのですか? 問題が何なのかが不明だと、問題解決は不可能ですよ。

    キャンセル

0

VBA高速化テクニック 配列を使う
http://officetanaka.net/excel/vba/speed/s11.htm

20万個のセルから検索する方法について
・セル1つ1つ参照する場合
・配列に突っ込んでけんさする場合
・Findを使う場合
で計測すると、配列に突っ込んだのが一番早いそうです
(試したら確かに同じ結果でした)

また、本当に遅い処理はセルへの代入とのことで、まとめられるなら一括で行うことで劇的に早くなるとのこと

以上ご参考まで

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/26 13:09

    Worksheet系はいつもエラーになってしまい今回もだめみたいです。エラー値はないと思うのですが・・・参考にします。

    キャンセル

  • 2019/02/26 15:47

    「Worksheet系はいつもエラーになってしまい」って、何のエラーが出ているのですか??? 普通、途中でエラーが出たら、正しい値を得て終わり、にならないんですが。

    キャンセル

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

  • ただいまの回答率 90.12%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる