エクセルの学校：全文検索：Hyper Estraier：（Mook）

Results of 1 - 1 of about 1215 for （Mook） (0.001 sec.)

[[20150227095007]]: #score: 9211; @digest: 6edbdff40c1b0e6f9dd25dda69b0734a; @id: 67361; @mdate: 2015-02-27T06:57:30Z; @size: 7834; @type: text/plain; #keywords: 業デ (52750), ib (44554), enablecalculation (35594), contxt (29523), conval (29072), 果デ (23268), 正デ (18228), タ( (12979), タ最 (8843), querytable (8404), 得() (8333), 得ma (7481), タ取 (6705), タ更 (6192), タ= (6106), backgroundquery (5324), paramarray (5011), refresh (4150), calculation (4026), 行, (3335), xlcalculationautomatic (2794), xlcalculationmanual (2765), cells (2668), デー (2407), 列( (2371), val (2161), screenupdating (2156), ータ (2128), application (1984), 再計 (1949), value (1861), 録日 (1807); 『ループしっ放しで「完了」とならない』（しゅう）
このコード↓だと数分で「完了」となりますが、その下のコードだと一晩置いてもループしっ放しになります。原因が判りません。何が考えられるでしょうか? 教えてください。よろしくお願いいたします。 Sub ?@データ取得() ' ' データ取得 Macro ' マクロ記録日 : 2011/9/13 ユーザー名 : メカ部 ' Worksheets("M").EnableCalculation = False '再計算しない Worksheets("J").EnableCalculation = False Worksheets("Sheet1").Select Range("F1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("a2:e20000").Select Selection.ClearContents Range("a1").Select iB = 1 Do While Cells(iB + 1, "F").Value <> "" Cells(iB + 1, "A").Value = Cells(iB + 1, "N").Value & Cells(iB + 1, "L").Value & Cells(iB + 1, "K").Value & Cells(iB + 1, "H").Value Cells(iB + 1, "B").Value = Cells(iB + 1, "N").Value & Cells(iB + 1, "L").Value & Cells(iB + 1, "H").Value Cells(iB + 1, "C").Value = Val(Cells(iB + 1, "J").Value) * Val(Cells(iB + 1, "O").Value) / 12 Cells(iB + 1, "D").Value = Val(Cells(iB + 1, "I").Value) * Val(Cells(iB + 1, "O").Value) / 12 iB = iB + 1 If iB = 40000 Then Exit Do Loop Worksheets("M").EnableCalculation = True '再計算する Worksheets("J").EnableCalculation = True MsgBox "データ更新しました" End Sub ________________________________ Sub ?@データ取得() ' ' データ取得 Macro ' マクロ記録日 : 2011/9/13 ユーザー名 : M部 ' Worksheets("M").EnableCalculation = False '再計算しない Worksheets("J").EnableCalculation = False Worksheets("Sheet1").Select Range("F1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("a2:e20000").Select Selection.ClearContents Range("a1").Select N修正 iB = 1 Do While Cells(iB + 1, "F").Value <> "" Cells(iB + 1, "A").Value = Cells(iB + 1, "N").Value & Cells(iB + 1, "L").Value & Cells(iB + 1, "K").Value & Cells(iB + 1, "H").Value Cells(iB + 1, "B").Value = Cells(iB + 1, "N").Value & Cells(iB + 1, "L").Value & Cells(iB + 1, "H").Value Cells(iB + 1, "C").Value = Val(Cells(iB + 1, "J").Value) * Val(Cells(iB + 1, "O").Value) / 12 Cells(iB + 1, "D").Value = Val(Cells(iB + 1, "I").Value) * Val(Cells(iB + 1, "O").Value) / 12 iB = iB + 1 If iB >= 10000 Then Exit Do Loop Worksheets("M").EnableCalculation = True '再計算する Worksheets("J").EnableCalculation = True MsgBox "データ更新しました" End Sub Sub N修正() iB = 1 Do While Cells(iB + 1, "F").Value <> "" If Cells(iB + 1, "N").Value = "KK7" And Cells(iB + 1, "K").Value = "9035" Then Cells(iB + 1, "K").Value = "9047" iB = iB + 1 If iB = 10000 Then Exit Do Loop End Sub ＜使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- Excel2010 Windows7 でデータは必要最低限(と思われる)で試したところ 5秒くらいで終了しましたが… ループが抜けられないわけではないのでデータが重すぎるか画面更新で容量が増えてるかかと思います Application.ScreenUpdating = False 条件 Application.ScreenUpdating = True これを追加でどうでしょう（とらねこ） 2015/02/27(金) 10:55 ---- シートのチェンジイベントとかもあるかも? テストしてないけど、書き換えるとこんな感じ? Sub データ取得() Dim iB As Long Application.Calculation = xlCalculationManual Application.EnableEvents = False Application.ScreenUpdating = False With Worksheets("Sheet1") 'Selection.QueryTable.Refresh BackgroundQuery:=False .Range("a2:e20000").ClearContents iB = 2 Do While .Cells(iB, "F").Value <> "" .Cells(iB, "A").Value = ConTxt(.Name, iB, "N", "L", "K", "H") .Cells(iB, "B").Value = ConTxt(.Name, iB, "N", "L", "H") .Cells(iB, "C").Value = ConVal(.Name, iB, "J", "D") / 12 .Cells(iB, "D").Value = ConVal(.Name, iB, "I", "O") / 12 iB = iB + 1 If iB = 40000 Then Exit Do Loop End With Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "データ更新しました" End Sub Private Function ConTxt(ByVal shn As String, i As Long, ParamArray C()) As String Dim x With Sheets(shn) For Each x In C ConTxt = ConTxt & .Cells(i, x).Value Next x End With End Function Private Function ConVal(ByVal shn As String, i As Long, ParamArray C()) As Double Dim x ConVal = 1 With Sheets(shn) For Each x In C ConVal = ConVal * .Cells(i, x).Value Next x End With End Function （稲葉） 2015/02/27(金) 11:03 ---- 皆様ありがとうございます。まず、どらねこさんの追加で試したのですが「コンパイルエラー」が出ました。 End Subの次の行に書き足すだけではダメなのでしょうか? 無知すぎてすみません。（しゅう） 2015/02/27(金) 13:16 ---- コンパイルエラーは私のほうですね。やっぱりテストだけでもしておくべきだった・・・差し替えましたので、確認してください。（稲葉） 2015/02/27(金) 13:51 ---- 下から失礼しますが、 >「コンパイルエラー」が出ました。は別件では? > End Subの次の行に書き足すだけではダメなのでしょうか? End Sub の次に書き足してはダメです。基本的にコードは Sub ・・・・・・ End Sub の中に書いてください。外に書いていいのはオプションと変数と参照の宣言くらいです。位置は稲葉さんのコメントのコードを参照ください。 （Mook） 2015/02/27(金) 13:54 ---- Mookさんが書いていますが Sub … () Application.ScreenUpdating = False '動かしたいマクロ内容 Application.ScreenUpdating = True End Sub このように書いてください "エクセルマクロ画面更新" などで検索すると参考になるページがたくさん出てきますよ（とらねこ） 2015/02/27(金) 14:08 ---- 記念参加で。 Sub データ取得() Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Worksheets("Sheet1").Activate Range("A2:E10000").ClearContents If Range("F2").Value = "" Then Exit Sub Dim データ最終行 As Long データ最終行 = Application.Min(10000, Range("F1").End(xlDown).Row) '// 空白で終了なので xlDown で Dim 結果データ結果データ = Range("A1").Resize(データ最終行, 4) '// A列(1)〜D列(4) Dim 修正データ修正データ = Range("K1").Resize(データ最終行, 1) '// K列(1) Dim 作業データ作業データ = Range("H1").Resize(データ最終行, 8) '// H列(1)〜O列(8) : H(1) I(2) J(3) K(4) L(5) M(6) N(7) O(8) Dim r As Long For r = 2 To データ最終行 If 作業データ(r, 7) = "KK7" And 作業データ(r, 4) = "9035" Then '// 修正処理作業データ(r, 4) = "9047" 修正データ(r, 1) = "9047" End If 結果データ(r, 1) = 作業データ(r, 7) & 作業データ(r, 5) & 作業データ(r, 4) & 作業データ(r, 1) 結果データ(r, 2) = 作業データ(r, 7) & 作業データ(r, 5) & 作業データ(r, 1) 結果データ(r, 3) = Val(作業データ(r, 3)) * Val(作業データ(r, 8)) / 12 結果データ(r, 4) = Val(作業データ(r, 1)) * Val(作業データ(r, 8)) / 12 Next Range("A1").Resize(データ最終行, 4) = 結果データ Range("K1").Resize(データ最終行, 1) = 修正データ Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.EnableEvents = True MsgBox "データ更新しました" End Sub （Mook） 2015/02/27(金) 15:57 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/201502/20150227095007.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ