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

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

ただいまの
回答率

90.33%

  • VBA

    1911questions

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

  • Excel

    1646questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

VBAの動作が重すぎて応答しない

解決済

回答 8

投稿 編集

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

jun_endo

score 48

環境

OS:windows10
ラップトップのパソコンを使用しています。
購入時期:去年

やっていること

今現在、やっていることは、
設計図のデータ(.CSV)をexcelのVBAで、
必要な情報のみを抽出するプログラムを書いています。

ただ、処理するデータの量がテストデータ(運用を想定したデータ量)で
60000件あります。
それを処理しようとすると、
「応答なし」になってしまい、うまく最後まで処理ができません。

プログラム

量が多く、一応コンパイルは成功しているはずなので、 軽く目を通す程度にすることを推奨します。

一番最初に実行するのは、標準モジュール側の、「寸法書作成」というサブルーチンです。

その後、ユーザーフォームを起動して、
コマンドボタンを、クリックすると必要な情報が、
テキストボックスに記入されているかを「エラーチェックサブルーチン」で、
確認したのち、各変数に代入後、標準モジュールに戻ります。

標準モジュールでは、必要な情報のみをえらんで、
別のシートに出力するというものです。

UserForm側--------------------------------------------------------
Option Explicit
Public e_name, アルファベット As Variant
-------------------------------------------------------------------
Private Sub CommandButton1_Click()

While sw = 0
    Call エラーチェック
Wend

'各座標を取得する
左上座標x = TextBox1.Text: 左上座標y = TextBox2.Text
左下座標x = TextBox3.Text: 左下座標y = TextBox4.Text
右上座標x = TextBox5.Text: 右上座標y = TextBox6.Text
右下座標x = TextBox7.Text: 右下座標y = TextBox8.Text

'入力エラー時にウィンドウを閉じなくする。&寸法の処理を実行しないよう制御
If e_name = "none" Then
    Unload UserForm1
End If




End Sub
------------------------------------------------------------------
Private Sub CommandButton2_Click()
'クリアボタン
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
End Sub
-------------------------------------------------------------------
Private Sub CommandButton3_Click()
'終了ボタン
End
End Sub
-------------------------------------------------------------------
Private Sub エラーチェック()
On Error GoTo Error

Dim a As Byte
'エラーの種類を区別する変数
e_name = "none"
'入力された文字列を探索する文字列(アルファベット大小32文字)
アルファベット = "abcdefghijklmnpoqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"


For a = 0 To 31
'空白の探索
    If TextBox1.Text = "" Or _
        TextBox2.Text = "" Or _
        TextBox3.Text = "" Or _
        TextBox4.Text = "" Or _
        TextBox5.Text = "" Or _
        TextBox6.Text = "" Or _
        TextBox7.Text = "" Or _
        TextBox8.Text = "" Then

        e_name = "blank"
        GoTo Error

    End If
'文字列が混入していないか調べる
    If InStr(TextBox1.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _
    InStr(TextBox2.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _
    InStr(TextBox3.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _
    InStr(TextBox4.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _
    InStr(TextBox5.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _
    InStr(TextBox6.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _
    InStr(TextBox7.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _
    InStr(TextBox8.Text, Mid(アルファベット, a + 1, 1)) <> 0 Then
        e_name = "string"
        GoTo Error

    End If
'コンマがちゃんと入っているか確認
    If TextBox1.Text = Int(TextBox1.Text) Or _
       TextBox2.Text = Int(TextBox2.Text) Or _
       TextBox3.Text = Int(TextBox3.Text) Or _
       TextBox4.Text = Int(TextBox4.Text) Or _
       TextBox5.Text = Int(TextBox5.Text) Or _
       TextBox6.Text = Int(TextBox6.Text) Or _
       TextBox7.Text = Int(TextBox7.Text) Or _
       TextBox8.Text = Int(TextBox8.Text) Then

'    If InStr(TextBox1.Text, ".") <> 1 Or _
        InStr(TextBox2.Text, ".") <> 1 Or _
        InStr(TextBox3.Text, ".") <> 1 Or _
        InStr(TextBox4.Text, ".") <> 1 Or _
        InStr(TextBox5.Text, ".") <> 1 Or _
        InStr(TextBox6.Text, ".") <> 1 Or _
        InStr(TextBox7.Text, ".") <> 1 Or _
        InStr(TextBox8.Text, ".") <> 1 Then
        e_name = "notcon"
        GoTo Error

    End If
Next a




'例外処理

Error:
Select Case e_name
    Case "string"
        MsgBox ("余分な文字が混入しています。")

    Case "blank"
        MsgBox ("空白の欄が存在します。すべて記入してください。")

    Case "notcon"
        MsgBox ("コンマが抜けているか、二つ以上存在します。")

    Case "none"
        sw = 1

End Select

End Sub
-------------------------------------------------------------------
標準モジュール側-----------------------------------------------------

Option Explicit

Public sn, sw As Byte
Public 右上座標x, 右下座標x, 左上座標x, 左下座標x As Variant
Public 右上座標y, 右下座標y, 左上座標y, 左下座標y As Variant
Public 始点x, 始点y, 差分x As Integer
Public 終点x, 終点y, 差分y As Integer

-------------------------------------------------------------------
Public Sub 寸法書作成()



sw = 0
UserForm1.Show


'先に範囲指定
Call 範囲指定





'抽出する項目の設定
Dim meji配列 As Variant
meji配列 = Array("●09石仕上面", "●08石裏", "●08石仕上(平面・原寸石裏)", "●11石目地(目地有)", "●18石番号")

'行変数の初期設定
Dim row As Integer
row = 2

'シート作成
Call シート作成


'セルが空白になるまで探索する
Dim meji As Variant

While Worksheets(1).Cells(20, row) <> "" '20列目は「画層」
    For Each meji In meji配列
        If Worksheets(1).Cells(20, row) = meji Then

            '指定した範囲に存在しているか調べる
            If Cells(131, row) >= 始点x And Cells(132, row) >= 始点y And _
               Cells(134, row) <= 終点x And Cells(135, row) <= 終点y Then
                With Worksheets(sn + 1)
                    .Cells(1, 2) = Worksheets(1).Cells(20, row)
                    .Cells(2, 2) = Worksheets(1).Cells(131, row)
                    .Cells(3, 2) = Worksheets(1).Cells(132, row)
                    .Cells(4, 2) = Worksheets(1).Cells(134, row)
                    .Cells(5, 2) = Worksheets(1).Cells(135, row)
                End With
            End If
        End If
    Next meji
Wend





End Sub
-------------------------------------------------------------------

Sub 範囲指定()
'r = right(右)
'l = left(左)
'o = over(上)
'u = under(下)
'x = x軸
'y = y軸

Dim rox, rux, lox, lux As Integer
Dim roy, ruy, loy, luy As Integer

'各座標を千の位未満を切り捨てる
lox = WorksheetFunction.Round(左上座標x / 1000, "0"): loy = WorksheetFunction.Round(左上座標y / 1000, "0")
lux = WorksheetFunction.Round(左下座標x / 1000, "0"): luy = WorksheetFunction.Round(左下座標y / 1000, "0")
rox = WorksheetFunction.Round(右上座標x / 1000, "0"): roy = WorksheetFunction.Round(右上座標y / 1000, "0")
rux = WorksheetFunction.Round(右下座標y / 1000, "0"): ruy = WorksheetFunction.Round(右下座標y / 1000, "0")

'座標の範囲を求める
'd = difference(差分)
Dim oxd, uxd, lyd, ryd  As Integer

'上底側のx軸の差分 = 右上座標x - 左上座標x
oxd = rox - lox

'下底側のx軸の差分 = 右下座標x - 左下座標x
uxd = rux - lux

'左辺側のy軸の差分 = 左上座標y - 左下座標y
lyd = loy - luy

'右辺側のy軸の差分 = 右上座標y - 右下座標y
ryd = roy - ruy

'x軸の始点と終点と差分の決定
If oxd = uxd Then
    始点x = lox
    終点x = rox
    差分x = oxd
Else
    If oxd > uxd Then
        始点x = lox
        終点x = rox
        差分x = oxd
    Else
        If oxd < uxd Then
            始点x = lux
            終点x = rux
            差分x = uxd
        End If
    End If
End If

'y軸の始点と終点と差分の決定
If lyd = ryd Then
    始点y = luy
    終点y = loy
    差分y = lyd
Else
    If lyd > ryd Then
        始点y = luy
        終点y = loy
        差分y = lyd
    Else
        If lyd < ryd Then
            始点y = ruy
            終点y = roy
            差分y = ryd
        End If
    End If
End If



End Sub
-------------------------------------------------------------------
Sub シート作成()
sn = Worksheets.Count
Worksheets().Add After:=Worksheets(sn)
With Worksheets(sn + 1)
    .Cells(1, 1) = "画層"
    .Cells(1, 2) = "始点x"
    .Cells(1, 3) = "始点y"
    .Cells(1, 4) = "終点x"
    .Cells(1, 5) = "終点y"
End With

End Sub
-------------------------------------------------------------------

上記がプログラムの一覧です。

自分の考えとしては...

今私が考えている方法では、
ミニバッチ化してしまえば応答なしにはならないのではないか、
と考えています。

ただ、それでもうまくいかないとも考えています。
なので、時間は多少かかってもいいので、
応答なしにならずに処理する方法を知りたいです。

どなたか、わかる方いらしゃれば教えてください。

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

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

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

  • mts10806

    2018/07/17 15:54

    60000万だと6億では。

    キャンセル

回答 8

+1

ずーっとセル1つ1つに値を入れてたら、そら遅いよね。

というか、何の高速化もされてないから、
「VBA 高速化」くらいは調べてみたら?

・配列を一気にセルに値を代入(今回の場合は1行単位)
・画面更新の停止、再開
・数式の停止、再開
・DoEvents(但し、使いすぎると遅いので、1秒に1回等と要調整)

上記調整ができれば、
そのままシートに取り込んでもいいだろうし、
先にDB(AccessやSQLServer)に突っ込んでおいて、
SQLで取り出してもいいし。

列が数えるほどの列数だし、
最近のPCなら6万件程度なら処理できるんじゃないかなぁ。

あ、限界に調整する感じなら最初からDB検討の1択かと。
自分の経験からは数十万まではいけそうな気がする。

まぁがんばって。。。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/07/17 17:12

    言い忘れてた。
    同じような処理は共通関数化してね。

    その方が、見やすいし、メンテしやすいし、
    うまく作れば開発効率が劇的に変わるから。

    その作り方を続けてたら、
    いつまでたっても定時で帰れないよ。。。

    キャンセル

  • 2018/07/17 17:21

    共通関数化について調べましたが、
    call文で処理を呼び出すのと、
    なのが違うのでしょうか?
    根本的なところの動きで、やはり違うところがあるのでしょうか?

    キャンセル

  • 2018/07/17 18:52

    「InStr(TextBox1.Text, Mid(アルファベット, a + 1, 1)) <> 0」
    こういう処理を何回も書く(コピペも含めて)のであれば、
    関数化して使おうよってことです。

    もし Sub と Function の違いが分からないのであれば、
    それは自分で調べてください。
    (ほとんどの関数は Function になる確率が高いはず)

    せっかくだから、TextBox1~8を配列に入れて、
    For文で回して処理した方が、
    簡潔になるし、TextBoxの増減にも対応できると思うよ。

    キャンセル

  • 2018/07/18 10:02

    ありがとうございます!
    無事実行できるようになりました!
    以外に処理が速かったので、高速化の心配はなさそうです…

    キャンセル

checkベストアンサー

0

提示されているコードは実際のものでしょうか? 提示されたコードで見た限りでは、
おそらく応答なしになるのは「寸法書作成」のwhile文だと思います。
ループの中で変数rowがインクリメントされていませんので、無限ループになるのではないでしょうか?

あと、

While Worksheets(1).Cells(20, row) <> "" '20列目は「画層」

の記述ですが、rowが行番号の意味であるなら行と列が逆です。
cellsの指定は、~.cells(行、列) です。他もすべて逆のようです。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/07/18 09:01

    http://kabu-macro.com/vba_apply/cells-offset.html

    こちらに書いてあることを参考にして記述したのですが、
    上記が間違っているということですか?

    キャンセル

  • 2018/07/18 09:13

    >Rangeプロパティ ⇒  Range("C4")
    >Cellsプロパティ  ⇒  Cells("3,4")
    はい、間違いです。
    そもそもcellsの行と列は数値で指定します。引用符を使用していること自体が間違いです。
    だだし、列に関しては文字も使用できます。【例】→cells(4,"C")

    ※御自身で実際に試してみられることをおすすめします。

    キャンセル

  • 2018/07/18 10:03

    ありがとうございます!
    非常にお恥ずかしいミスでした…

    キャンセル

  • 2018/07/18 10:10

    あと一点、細かいところですが、コードを読んでいて気がついた点です。

    「sub 範囲指定」のruxを求める式中の「右下座標y」は「右下座標x」ではないでしょか?

    rux = WorksheetFunction.Round(右下座標y / 1000, "0")

    rux = WorksheetFunction.Round(右下座標x / 1000, "0")

    ※ここだけ「y」だったので。思い違いだったらすいません。

    キャンセル

  • 2018/07/18 10:12

    はいそうです!
    そのミスについては、
    エクセル側で修正しました!
    最後までありがとうございます!

    キャンセル

0

60000万件あります。

6億件もあったら表計算ソフトではなく、きちんとデータベースを使うべき案件です。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/07/17 16:00

    内容変更しました。
    それを前提で、もう一度考えを、
    教えていただけないでしょうか?

    キャンセル

  • 2018/07/17 16:09

    60,000件とか6万件、って書きませんか?
    6万件でもデータベースを使うことをお勧めします。

    キャンセル

  • 2018/07/18 09:59

    分かりました!
    DBの使用も検討します!

    キャンセル

0

一つのファイルで、60,000万件(=6億件)ですか?
そんな量なら何の処理もなくエクセルで開こうとしても応答なしになると思いますので、運用を想定したデータ量とは思えませんけど。
複数のファイルで、合計がその件数になるとしたら、エクセルではなくデータベースの利用を考えられたほうが良いと思います。

追記

以下参考。
VBA高速化テクニック
特に、セルを配列に入れるは効果がありそうです。

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/07/17 16:05

    内容変更しました。
    もう一度、
    ご意見いただけないでしょうか?

    キャンセル

0

「応答なし」になるのは、処理が終わっていないのにウィンドウを触ろうとするからです。
例え応答なしになっても、処理が終わるまで待てば大丈夫だと思います。
ただ、この手の処理の場合、あらゆる高速化の手段は必須と思います。
そこらへんはsaziさんの回答を見ていただくとして、最低限「応答なし」を回避するために、ループの要所にDoEventsは必須です。
これで「応答なし」は回避できますし、途中で止めることも可能です。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/07/18 09:59

    ありがとうございます!
    DoEventsも使っていきたいと思います。

    キャンセル

0

1日は86,400秒です。6億件(60000万件)を1日で処理するには、6945件/秒の処理能力を必要とします。

とりあえず、7000件ぐらいの小規模なテストデータを作って処理時間がどのぐらいかかるか測定することをお勧めします。

7000件が1秒で終われば、6億件が1日程度で処理できますから、どうにか待つことができるでしょう。

7000件の処理に1分かかるようだと、6億件のテストデータの処理に2か月かかりますから、パソコンが非力すぎるか、テストデータの規模が非常識なのだと考えられます。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/07/18 09:58

    ありがとうございます!
    2か月後にまたよろしくお願いします!

    キャンセル

0

処理そのものは正しい前提での解答です。
自信がない場合は100件程度のデータで、本当に
正しく処理が行われているか試してみると良いと思います。

ループ中に適度に、 DoEvents を通るようにして、
OSに処理を返してやるといいと思います。

後、アナログですが、
処理の進行度(10%完了とか)を表示してあげると、
ユーザが無理やり操作をしたりする事が少なくなるのでお勧めです。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/07/18 10:00

    古典的ですが、非常に簡単だと思います!
    ありがとうございます!

    キャンセル

0

読み込むデータがCSVということなので、ADOでSQLで抽出条件を設定して必要なデータのみ読み込むという方法も検討されるといいかも。

ADOを使って、CSVファイルを読み込む - VBA - TIL

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

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

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

同じタグがついた質問を見る

  • VBA

    1911questions

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

  • Excel

    1646questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。