エクセルについての質問です。少しややこしいので200ポイント差し上げます。


プログラムの動作が遅いので改善して下さい。


ばらばらに並んだ同一文字列のある行を、同じ文字列を持つ行の下にそろえるプログラムです。

例えば

1234 re
2345 rt
3456 ty
2345 ty
1234 5t

を一列目でそろえると、

1234 re
1234 5t
2345 rt
2345 ty
3456 ty

となるプログラムです。

次のプログラムを作成しました。しかし5000行に対して実行したところ

Selection.Insert Shift:=xlDown

で異常に遅い(1つ挿入するのに10秒以上)かかります。

どこがおかしいのでしょうか?
修正していただけるとありがたいです。


Sub irekae()
i = 1
Do Until Cells(i, 5) = ""
cnt = 1
j = i + 1
Do Until Cells(j, 5) = ""
If Cells(i, 5) = Cells(j, 5) Then
Rows(j & ":" & j).Select
Selection.Cut
Rows(i + cnt & ":" & i + cnt).Select
Selection.Insert Shift:=xlDown
cnt = cnt + 1
End If
j = j + 1
Loop
i = i + cnt
Loop
End Sub

回答の条件
  • 1人2回まで
  • 登録:2006/09/30 02:40:06
  • 終了:2006/10/01 07:09:16

ベストアンサー

id:rikuzai No.3

りくっち回答回数1366ベストアンサー獲得回数1412006/09/30 08:34:26

ポイント60pt

修正案でなくて恐縮なのですが、

  • タイトル行なし
  • アクティブの表全体をA列基準で昇順に並び替えて同一文字列を整頓する

という作業でよいのならということで並び替え機能を使ったやり方を一案。

基本的にカット&ペーストはメモリを食うので、動作が遅くなりがちですし。

処理したい範囲の左上にカーソルをセット(A1:B5ならA1にカーソルを置いて)してマクロ実行してください。

(該当範囲の選択に関しては、作業シートの状態によっては別コードにした方がいいかもしれませんが)

ちなみに↓のコードはB列にも昇順かけているので、

不要の場合は「Key2~」の行を削除してください。


Sub narabikae()

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort _
        Key1:=Range("A1"), Order1:=xlAscending, _
        Key2:=Range("B1"), Order2:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
End Sub
id:ReoReo7

使用しましたが、非常に有効に動きました。ありがとうございました。

2006/10/01 07:03:45

その他の回答(6件)

id:Gazebo No.1

Gazebo回答回数3ベストアンサー獲得回数02006/09/30 07:52:39

ポイント20pt

最初に、描画を止めるだけでも高速になりますよ。

すでにされているのでしたらごめんなさい。

Sub irekae()

'描画停止

Application.ScreenUpdating = False

(ぷろぐらむ)

'描画再開

Application.ScreenUpdating = True

End Sub

id:ReoReo7

ありがとうございます。試してみます。どうやら表示ではなく、セルの並び替え時に再計算が必要なのが原因なようです。

2006/10/01 07:03:08
id:tikirou No.2

tikirou回答回数80ベストアンサー獲得回数82006/09/30 08:16:30

ポイント20pt

修正してみました。

1.変数は型宣言する

2.画面の描写は止める

3.SELECTは使わない

今、ちょっと動作できる環境がないので

実は動くかわかりません・・・・。

Sub irekae()

Dim i As Integer, j As Integer, cnt As Integer

Application.ScreenUpdating = False

i = 1

Do Until Cells(i, 5) = ""

cnt = 1

j = i + 1

Do Until Cells(j, 5) = ""

If Cells(i, 5) = Cells(j, 5) And (i + 1 <> j) Then

Rows(j).Cut

Rows(i + cnt).Insert Shift:=xlDown

cnt = cnt + 1

End If

j = j + 1

Loop

i = i + cnt

Loop

Application.ScreenUpdating = True

id:ReoReo7

どうもありがとうございます。参考にさしていただきます。

2006/10/01 07:03:26
id:rikuzai No.3

りくっち回答回数1366ベストアンサー獲得回数1412006/09/30 08:34:26ここでベストアンサー

ポイント60pt

修正案でなくて恐縮なのですが、

  • タイトル行なし
  • アクティブの表全体をA列基準で昇順に並び替えて同一文字列を整頓する

という作業でよいのならということで並び替え機能を使ったやり方を一案。

基本的にカット&ペーストはメモリを食うので、動作が遅くなりがちですし。

処理したい範囲の左上にカーソルをセット(A1:B5ならA1にカーソルを置いて)してマクロ実行してください。

(該当範囲の選択に関しては、作業シートの状態によっては別コードにした方がいいかもしれませんが)

ちなみに↓のコードはB列にも昇順かけているので、

不要の場合は「Key2~」の行を削除してください。


Sub narabikae()

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort _
        Key1:=Range("A1"), Order1:=xlAscending, _
        Key2:=Range("B1"), Order2:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
End Sub
id:ReoReo7

使用しましたが、非常に有効に動きました。ありがとうございました。

2006/10/01 07:03:45
id:takashi_m17 No.4

たか回答回数104ベストアンサー獲得回数122006/09/30 09:28:57

10行目の判定時、1~9行目に同じ文字がないか?でいいのに、このマクロでは

10行目でも1~5000行目に同じ文字がないか?となっています


Sub irekae()

For x = 2 To 5000

If Cells(x, 1) = "" Then Exit For

a = Cells(x, 1)

For y = 1 To x

z = x - y

If z = 0 Then Exit For

If Cells(x, 1) = Cells(z, 1) Then

If (z + 1 = x) Then Exit For

Rows(x & ":" & x).Select

Selection.Cut

Rows(z + 1 & ":" & z + 1).Select

Selection.Insert shift:=xlDown

End If

Next

Next

End Sub

5000行で試しましたが、1行1秒も掛かりませんでした

サッと終わるものでもないですが・・・

id:ReoReo7

そういう間違いがあるのですね。ありがとうございました。

2006/10/01 07:04:10
id:takashi_m17 No.5

たか回答回数104ベストアンサー獲得回数122006/09/30 09:36:42

ポイント50pt

Sub irekae()

For x = 2 To 5000

If Cells(x, 1) = "" Then Exit For

a = Cells(x, 1)

For y = 1 To x

z = x - y

If z = 0 Then Exit For

If Cells(x, 1) = Cells(z, 1) Then

If (z + 1 = x) Then Exit For

Rows(x & ":" & x).Select

Selection.Cut

Rows(z + 1 & ":" & z + 1).Select

Selection.Insert shift:=xlDown

Exit For

End If

Next

Next

End Sub

id:ReoReo7

了解です

2006/10/01 07:04:19
id:ardarim No.6

ardarim回答回数896ベストアンサー獲得回数1442006/09/30 10:32:17

ポイント20pt

プログラムそのものに間違いはなく、これ以上直しようがないと思います。


Excelの仕様として、画面更新を行いながらマクロを動かすとどうしても動作が遅いことがあります。(例えば、データ量の多いファイルで切り取り、挿入を繰り返す今回のような場合)


その場合、プログラムの先頭で

Application.ScreenUpdating = False

を実行すると、マクロ実行中は画面更新がOFFになりますので、マクロの実行がかなり早くなります。

id:ReoReo7

ご指摘いただきありがとうございます。

2006/10/01 07:04:30
id:Ma2 No.7

Ma2回答回数11ベストアンサー獲得回数02006/09/30 19:11:38

ポイント30pt

実行結果は多少変わりますが、こんな方法はいかがでしょう。

Excel本体のソートを利用するやり方です。

Sub Macro1()

Range("F1").End(xlDown).End(xlToLeft).Select

Application.CutCopyMode = False

Selection.Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _

:=xlPinYin

End Sub

id:ReoReo7

いい感じで動きました。ありがとうございました。

2006/10/01 07:04:45
  • id:ReoReo7
    このページが関係ありそうですが、理解できません。
    どなたか変わりに理解してくれませんか。

    http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=39047;id=excel
  • id:taknt
    あ、最初の質問に 若干高速化したものを 回答しておきました。

  • id:tikirou
    すみません、回答の条件式間違ってました。
    If Cells(i, 5) = Cells(j, 5) And (i + 1) <> j Then

    if Cells(i, 5) = Cells(j, 5)
    に戻してifの中の処理で
    (i+1) と j が一緒だったら
    Insert先を一個下にずらすようにして下さい。

    同じ値が2個続くことがないなら
    Insert先をずらす処理はいりません。
  • id:takashi_m17
    あ、2つ目の回答に1つ目を高速化したものを回答しておきます。
    1つ目開けなくて結構です。
  • id:takashi_m17
    あと、例で「1234」という文字列がありますが、それが複数出た場合どこに入れるのか・・・
    1234 re
    1234 5t

    3つ目「1234」が出たら私の作ったものは「re」下ではなく、「5t」の下に入るようになってます。
  • id:Mook
    http://q.hatena.ne.jp/1159544527に新規のアルゴリズムでの回答をしました。
    5000行×8列のデータでやってみましたが、5年前のPC(PentiamⅣ、1.5GHz)で23秒でした。
    お試しいただければ幸いです。
  • id:ReoReo7
    >takntさん
    ありがとうございます。見ておきます。

    >tikironさん
    了解です!!

    >takashiさん
    それが丁度望みでした♪

    >Mookさん
    どうもありがとうございます。最速ですね!!

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません