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

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

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

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

Q&A

解決済

1回答

285閲覧

do ~ loop文の記述

onionion

総合スコア13

VBA

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

0グッド

0クリップ

投稿2018/09/14 04:57

編集2018/09/14 05:20

前提・実現したいこと

excelのvbaで第一順位:D列、第二順位H列で並び替えを行うマクロを作成中です。
マクロを動作させるシートには5列目から数値が入っており、
A列の値が変更された直前と直後の間に、そこまでの合計を計算する行が挿入されています。
また、この行の移動は不可能です。
合計を計算する行にはA列に何も入力されていないので、
①「マクロ」シートのD3セルを確認。
D3セルにはマクロを動かすシートを選択できるようになっています。
②「マクロ」シートで宣言した名前と同じ名を持つシートの中で
A列が空白セルが出るまで並び替えを実施する。
空白セルが出たらその行を1行飛ばしてループ。
飛ばした先も空白であれば終了。
③「マクロ」シートのD列(3行目以降)が空白になるまで繰り返す。

この機能を実装中に以下の問題が発生しました。

発生している問題・エラーメッセージ

エラーメッセージは出ませんでしたが、ループから抜け出せてないであろう、 フリーズ→強制再起動コンボが発動します。

該当のソースコード

vba

1Sub 並び替え() 2Dim i As Integer 3Dim j As Integer 4Dim k As Integer 5Dim sh As String 6 7 k = 3 8 sh = Worksheets("マクロ").Range("D" & k).Value 9 10 i = ThisWorkbook.Worksheets(sh).Cells(5, 1).End(xlDown).Row 11 j = 5 12 13 On Error Resume Next 14 15 Do 16 'D列に入力がなくなるまで繰り返す 17 If sh <> "" Then 18 19 Do 20 'A5~ 21 'このあたりは問題なさそうです。 22 If Range("A" & j).Value <> "" Then 23 Range("A" & j & ":O" & i).Select 24 ThisWorkbook.Worksheets(sh).Sort.SortFields.Clear 25 ThisWorkbook.Worksheets(sh).Sort.SortFields.Add Key:=Range( _ 26 "D" & j & ":D" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 27 xlSortTextAsNumbers 28 ThisWorkbook.Worksheets(sh).Sort.SortFields.Add Key:=Range( _ 29 "H" & j & ":H" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 30 xlSortNormal 31 32 With ThisWorkbook.Worksheets(sh).Sort 33 .SetRange Range("A" & j - 1 & ":O" & i) 34 .Header = xlYes 35 .MatchCase = False 36 .Orientation = xlTopToBottom 37 .SortMethod = xlPinYin 38 .Apply 39 End With 40 41 j = i + 2 42 i = Cells(j, 1).End(xlDown).Row 43 44 Else 45 Exit Do 46 End If 47 48 Loop 49 'ここまでは問題なさそうです。 50 51 'ここからループから抜け出せていない? 52 k = k + 1 53 54 Else 55 Exit Do 56 End If 57 58 Loop 59 60End Sub 61

補足情報(FW/ツールのバージョンなど)

win7 32bit excel2010です。

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

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

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

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

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

ttyp03

2018/09/14 05:03

コードのネストをきちんとしてください。この手の無限ループしてる可能性があるコードをチェックするにあたって、可読性が非常に悪いです。
coco_bauer

2018/09/14 05:18

申し訳ないですが質問が理解できません。例えば「A列の値が変更された直前と直後の間に、そこまでの合計を計算する行が挿入されています」とありますが、A列のセルの値を変更する事に関して説明されていません。並び替えの第2順位のはずなのにH列の値に関する説明もありません。
guest

回答1

0

ベストアンサー

他にも原因があるかもしれませんが、とりあえずこれはまずいです。

VBA

1'D列に入力がなくなるまで繰り返す 2If sh <> "" Then

shは最初に取得した値で固定になってしまっているので無限ループになります。
少なくともこうしましょう。

VBA

1'D列に入力がなくなるまで繰り返す 2sh = Worksheets("マクロ").Range("D" & k).Value ' ←追加 3If sh <> "" Then

というかシートごとに必要そうな処理なので、最初の処理をループ内に持っていったほうがいいのかもしれません。

VBA

1On Error Resume Next 2 3k = 3 4Do 5 sh = Worksheets("マクロ").Range("D" & k).Value 6 7 'D列に入力がなくなるまで繰り返す 8 If sh <> "" Then 9 10 i = ThisWorkbook.Worksheets(sh).Cells(5, 1).End(xlDown).Row 11 j = 5

投稿2018/09/14 05:19

ttyp03

総合スコア16996

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

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問