Q&A
60000万だと6億では。
#環境
OS:windows10
ラップトップのパソコンを使用しています。
購入時期：去年
#やっていること
今現在、やっていることは、
設計図のデータ（.CSV）をexcelのVBAで、
必要な情報のみを抽出するプログラムを書いています。
ただ、処理するデータの量がテストデータ（運用を想定したデータ量）で
60000件あります。
それを処理しようとすると、
「応答なし」になってしまい、うまく最後まで処理ができません。
###プログラム
量が多く、一応コンパイルは成功しているはずなので、
軽く目を通す程度にすることを推奨します。
一番最初に実行するのは、標準モジュール側の、「寸法書作成」というサブルーチンです。
その後、ユーザーフォームを起動して、
コマンドボタンを、クリックすると必要な情報が、
テキストボックスに記入されているかを「エラーチェックサブルーチン」で、
確認したのち、各変数に代入後、標準モジュールに戻ります。
標準モジュールでは、必要な情報のみをえらんで、
別のシートに出力するというものです。
lang
1UserForm側-------------------------------------------------------- 2Option Explicit 3Public e_name, アルファベット As Variant 4------------------------------------------------------------------- 5Private Sub CommandButton1_Click() 6 7While sw = 0 8 Call エラーチェック 9Wend 10 11'各座標を取得する 12左上座標x = TextBox1.Text: 左上座標y = TextBox2.Text 13左下座標x = TextBox3.Text: 左下座標y = TextBox4.Text 14右上座標x = TextBox5.Text: 右上座標y = TextBox6.Text 15右下座標x = TextBox7.Text: 右下座標y = TextBox8.Text 16 17'入力エラー時にウィンドウを閉じなくする。＆寸法の処理を実行しないよう制御 18If e_name = "none" Then 19 Unload UserForm1 20End If 21 22 23 24 25End Sub 26------------------------------------------------------------------ 27Private Sub CommandButton2_Click() 28'クリアボタン 29TextBox1.Text = "" 30TextBox2.Text = "" 31TextBox3.Text = "" 32TextBox4.Text = "" 33TextBox5.Text = "" 34TextBox6.Text = "" 35TextBox7.Text = "" 36TextBox8.Text = "" 37End Sub 38------------------------------------------------------------------- 39Private Sub CommandButton3_Click() 40'終了ボタン 41End 42End Sub 43------------------------------------------------------------------- 44Private Sub エラーチェック() 45On Error GoTo Error 46 47Dim a As Byte 48'エラーの種類を区別する変数 49e_name = "none" 50'入力された文字列を探索する文字列（アルファベット大小３２文字） 51アルファベット = "abcdefghijklmnpoqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" 52 53 54For a = 0 To 31 55'空白の探索 56 If TextBox1.Text = "" Or _ 57 TextBox2.Text = "" Or _ 58 TextBox3.Text = "" Or _ 59 TextBox4.Text = "" Or _ 60 TextBox5.Text = "" Or _ 61 TextBox6.Text = "" Or _ 62 TextBox7.Text = "" Or _ 63 TextBox8.Text = "" Then 64 65 e_name = "blank" 66 GoTo Error 67 68 End If 69'文字列が混入していないか調べる 70 If InStr(TextBox1.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _ 71 InStr(TextBox2.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _ 72 InStr(TextBox3.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _ 73 InStr(TextBox4.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _ 74 InStr(TextBox5.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _ 75 InStr(TextBox6.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _ 76 InStr(TextBox7.Text, Mid(アルファベット, a + 1, 1)) <> 0 Or _ 77 InStr(TextBox8.Text, Mid(アルファベット, a + 1, 1)) <> 0 Then 78 e_name = "string" 79 GoTo Error 80 81 End If 82'コンマがちゃんと入っているか確認 83 If TextBox1.Text = Int(TextBox1.Text) Or _ 84 TextBox2.Text = Int(TextBox2.Text) Or _ 85 TextBox3.Text = Int(TextBox3.Text) Or _ 86 TextBox4.Text = Int(TextBox4.Text) Or _ 87 TextBox5.Text = Int(TextBox5.Text) Or _ 88 TextBox6.Text = Int(TextBox6.Text) Or _ 89 TextBox7.Text = Int(TextBox7.Text) Or _ 90 TextBox8.Text = Int(TextBox8.Text) Then 91 92' If InStr(TextBox1.Text, ".") <> 1 Or _ 93 InStr(TextBox2.Text, ".") <> 1 Or _ 94 InStr(TextBox3.Text, ".") <> 1 Or _ 95 InStr(TextBox4.Text, ".") <> 1 Or _ 96 InStr(TextBox5.Text, ".") <> 1 Or _ 97 InStr(TextBox6.Text, ".") <> 1 Or _ 98 InStr(TextBox7.Text, ".") <> 1 Or _ 99 InStr(TextBox8.Text, ".") <> 1 Then 100 e_name = "notcon" 101 GoTo Error 102 103 End If 104Next a 105 106 107 108 109'例外処理 110 111Error: 112Select Case e_name 113 Case "string" 114 MsgBox ("余分な文字が混入しています。") 115 116 Case "blank" 117 MsgBox ("空白の欄が存在します。すべて記入してください。") 118 119 Case "notcon" 120 MsgBox ("コンマが抜けているか、二つ以上存在します。") 121 122 Case "none" 123 sw = 1 124 125End Select 126 127End Sub 128------------------------------------------------------------------- 129
lang
1標準モジュール側----------------------------------------------------- 2 3Option Explicit 4 5Public sn, sw As Byte 6Public 右上座標x, 右下座標x, 左上座標x, 左下座標x As Variant 7Public 右上座標y, 右下座標y, 左上座標y, 左下座標y As Variant 8Public 始点x, 始点y, 差分x As Integer 9Public 終点x, 終点y, 差分y As Integer 10 11------------------------------------------------------------------- 12Public Sub 寸法書作成() 13 14 15 16sw = 0 17UserForm1.Show 18 19 20'先に範囲指定 21Call 範囲指定 22 23 24 25 26 27'抽出する項目の設定 28Dim meji配列 As Variant 29meji配列 = Array("●09石仕上面", "●08石裏", "●08石仕上(平面・原寸石裏)", "●11石目地(目地有)", "●18石番号") 30 31'行変数の初期設定 32Dim row As Integer 33row = 2 34 35'シート作成 36Call シート作成 37 38 39'セルが空白になるまで探索する 40Dim meji As Variant 41 42While Worksheets(1).Cells(20, row) <> "" '20列目は「画層」 43 For Each meji In meji配列 44 If Worksheets(1).Cells(20, row) = meji Then 45 46 '指定した範囲に存在しているか調べる 47 If Cells(131, row) >= 始点x And Cells(132, row) >= 始点y And _ 48 Cells(134, row) <= 終点x And Cells(135, row) <= 終点y Then 49 With Worksheets(sn + 1) 50 .Cells(1, 2) = Worksheets(1).Cells(20, row) 51 .Cells(2, 2) = Worksheets(1).Cells(131, row) 52 .Cells(3, 2) = Worksheets(1).Cells(132, row) 53 .Cells(4, 2) = Worksheets(1).Cells(134, row) 54 .Cells(5, 2) = Worksheets(1).Cells(135, row) 55 End With 56 End If 57 End If 58 Next meji 59Wend 60 61 62 63 64 65End Sub 66------------------------------------------------------------------- 67 68Sub 範囲指定() 69'r = right(右) 70'l = left(左) 71'o = over(上) 72'u = under(下) 73'x = x軸 74'y = y軸 75 76Dim rox, rux, lox, lux As Integer 77Dim roy, ruy, loy, luy As Integer 78 79'各座標を千の位未満を切り捨てる 80lox = WorksheetFunction.Round(左上座標x / 1000, "0"): loy = WorksheetFunction.Round(左上座標y / 1000, "0") 81lux = WorksheetFunction.Round(左下座標x / 1000, "0"): luy = WorksheetFunction.Round(左下座標y / 1000, "0") 82rox = WorksheetFunction.Round(右上座標x / 1000, "0"): roy = WorksheetFunction.Round(右上座標y / 1000, "0") 83rux = WorksheetFunction.Round(右下座標y / 1000, "0"): ruy = WorksheetFunction.Round(右下座標y / 1000, "0") 84 85'座標の範囲を求める 86'd = difference(差分) 87Dim oxd, uxd, lyd, ryd As Integer 88 89'上底側のx軸の差分 = 右上座標x - 左上座標x 90oxd = rox - lox 91 92'下底側のx軸の差分 = 右下座標x - 左下座標ｘ 93uxd = rux - lux 94 95'左辺側のy軸の差分 = 左上座標y - 左下座標y 96lyd = loy - luy 97 98'右辺側のy軸の差分 = 右上座標y - 右下座標y 99ryd = roy - ruy 100 101'x軸の始点と終点と差分の決定 102If oxd = uxd Then 103 始点x = lox 104 終点x = rox 105 差分x = oxd 106Else 107 If oxd > uxd Then 108 始点x = lox 109 終点x = rox 110 差分x = oxd 111 Else 112 If oxd < uxd Then 113 始点x = lux 114 終点x = rux 115 差分x = uxd 116 End If 117 End If 118End If 119 120'y軸の始点と終点と差分の決定 121If lyd = ryd Then 122 始点y = luy 123 終点y = loy 124 差分y = lyd 125Else 126 If lyd > ryd Then 127 始点y = luy 128 終点y = loy 129 差分y = lyd 130 Else 131 If lyd < ryd Then 132 始点y = ruy 133 終点y = roy 134 差分y = ryd 135 End If 136 End If 137End If 138 139 140 141End Sub 142------------------------------------------------------------------- 143Sub シート作成() 144sn = Worksheets.Count 145Worksheets().Add After:=Worksheets(sn) 146With Worksheets(sn + 1) 147 .Cells(1, 1) = "画層" 148 .Cells(1, 2) = "始点x" 149 .Cells(1, 3) = "始点y" 150 .Cells(1, 4) = "終点x" 151 .Cells(1, 5) = "終点y" 152End With 153 154End Sub 155-------------------------------------------------------------------
上記がプログラムの一覧です。
#自分の考えとしては...
今私が考えている方法では、
ミニバッチ化してしまえば応答なしにはならないのではないか、
と考えています。
ただ、それでもうまくいかないとも考えています。
なので、時間は多少かかってもいいので、
応答なしにならずに処理する方法を知りたいです。
どなたか、わかる方いらしゃれば教えてください。
回答8件
0
ずーっとセル１つ１つに値を入れてたら、そら遅いよね。
というか、何の高速化もされてないから、
「VBA 高速化」くらいは調べてみたら？
・配列を一気にセルに値を代入(今回の場合は１行単位)
・画面更新の停止、再開
・数式の停止、再開
・DoEvents(但し、使いすぎると遅いので、１秒に１回等と要調整)
上記調整ができれば、
そのままシートに取り込んでもいいだろうし、
先にDB(AccessやSQLServer)に突っ込んでおいて、
SQLで取り出してもいいし。
列が数えるほどの列数だし、
最近のPCなら６万件程度なら処理できるんじゃないかなぁ。
あ、限界に調整する感じなら最初からDB検討の１択かと。
自分の経験からは数十万まではいけそうな気がする。
まぁがんばって。。。
投稿2018/07/17 07:58
総合スコア1175
言い忘れてた。
同じような処理は共通関数化してね。
その方が、見やすいし、メンテしやすいし、
うまく作れば開発効率が劇的に変わるから。
その作り方を続けてたら、
いつまでたっても定時で帰れないよ。。。
共通関数化について調べましたが、
call文で処理を呼び出すのと、
なのが違うのでしょうか？
根本的なところの動きで、やはり違うところがあるのでしょうか？
「InStr(TextBox1.Text, Mid(アルファベット, a + 1, 1)) <> 0」
こういう処理を何回も書く（コピペも含めて）のであれば、
関数化して使おうよってことです。
もし Sub と Function の違いが分からないのであれば、
それは自分で調べてください。
(ほとんどの関数は Function になる確率が高いはず)
せっかくだから、TextBox1～8を配列に入れて、
For文で回して処理した方が、
簡潔になるし、TextBoxの増減にも対応できると思うよ。
ありがとうございます！
無事実行できるようになりました！
以外に処理が速かったので、高速化の心配はなさそうです…
0
ベストアンサー
提示されているコードは実際のものでしょうか? 提示されたコードで見た限りでは、
おそらく応答なしになるのは「寸法書作成」のwhile文だと思います。
ループの中で変数rowがインクリメントされていませんので、無限ループになるのではないでしょうか?
あと、
While Worksheets(1).Cells(20, row) <> "" '20列目は「画層」
の記述ですが、rowが行番号の意味であるなら行と列が逆です。
cellsの指定は、～.cells(行、列) です。他もすべて逆のようです。
投稿2018/07/17 23:48
総合スコア505
http://kabu-macro.com/vba_apply/cells-offset.html
こちらに書いてあることを参考にして記述したのですが、
上記が間違っているということですか？
>Rangeプロパティ ⇒ Range("C4")
>Cellsプロパティ ⇒ Cells("3,4")
はい、間違いです。
そもそもcellsの行と列は数値で指定します。引用符を使用していること自体が間違いです。
だだし、列に関しては文字も使用できます。【例】→cells(4,"C")
※御自身で実際に試してみられることをおすすめします。
ありがとうございます！
非常にお恥ずかしいミスでした…
あと一点、細かいところですが、コードを読んでいて気がついた点です。
「sub 範囲指定」のruxを求める式中の「右下座標y」は「右下座標x」ではないでしょか?
rux = WorksheetFunction.Round(右下座標y / 1000, "0")
↓
rux = WorksheetFunction.Round(右下座標x / 1000, "0")
※ここだけ「y」だったので。思い違いだったらすいません。
はいそうです！
そのミスについては、
エクセル側で修正しました！
最後までありがとうございます！
0
読み込むデータがCSVということなので、ADOでSQLで抽出条件を設定して必要なデータのみ読み込むという方法も検討されるといいかも。
投稿2018/07/17 07:47
総合スコア33715
0
１日は86,400秒です。６億件(60000万件)を１日で処理するには、6945件/秒の処理能力を必要とします。
とりあえず、7000件ぐらいの小規模なテストデータを作って処理時間がどのぐらいかかるか測定することをお勧めします。
7000件が１秒で終われば、６億件が１日程度で処理できますから、どうにか待つことができるでしょう。
7000件の処理に１分かかるようだと、６億件のテストデータの処理に２か月かかりますから、パソコンが非力すぎるか、テストデータの規模が非常識なのだと考えられます。
投稿2018/07/17 07:35
総合スコア6915
0
「応答なし」になるのは、処理が終わっていないのにウィンドウを触ろうとするからです。
例え応答なしになっても、処理が終わるまで待てば大丈夫だと思います。
ただ、この手の処理の場合、あらゆる高速化の手段は必須と思います。
そこらへんはsaziさんの回答を見ていただくとして、最低限「応答なし」を回避するために、ループの要所にDoEventsは必須です。
これで「応答なし」は回避できますし、途中で止めることも可能です。
投稿2018/07/17 07:28
総合スコア16998
0
一つのファイルで、60,000万件（=6億件）ですか？
そんな量なら何の処理もなくエクセルで開こうとしても応答なしになると思いますので、運用を想定したデータ量とは思えませんけど。
複数のファイルで、合計がその件数になるとしたら、エクセルではなくデータベースの利用を考えられたほうが良いと思います。
追記
以下参考。
VBA高速化テクニック
特に、セルを配列に入れるは効果がありそうです。
投稿2018/07/17 07:02
編集2018/07/17 07:15
総合スコア25195
あなたの回答
tips
プレビュー
