Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


64624 / 76732 ←次へ | 前へ→

【16688】Re:イミディエイトウインドウ
発言  ichinose  - 04/8/6(金) 1:30 -

引用なし
パスワード
   みなさん、こんばんは。

>個人的には、多分、でれすけ さんご提案のMatchが速いのではと思います。
>但し、データが昇順または降順になっている または、並べ替えても良い という前提の場合ですが。

Match関数、速かったですよ!!ソートされていない場合のでれすけさんのコードでも
かなりものです。

今回は、データ数10000のみのテストで行ってみました。
他のコードも ScreenupdatingのFalse、Trueや
配列でセルに書き込みできるコードは、そのようにしてみました。
例えば、Test2は、
'============================================================
Sub test2(out_time, cnt)
  st = Now()
  Dim myarray()
  Dim ans As Range
  Dim rng As Range
  Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
  ad = rng.Address
  With Range("d1:d" & cnt)
    .Formula = "=if(CountIf(" & ad & ",Row())=0,row(),"""")"
    .Value = .Value
    On Error Resume Next
    Set ans = .SpecialCells(xlCellTypeConstants)
    If Err.Number = 0 Then
      ReDim myarray(1 To ans.Count, 1 To 1)
      For Each cc In ans
       myarray(idx + 1, 1) = cc.Value
       idx = idx + 1
       Next
      Range(Cells(LBound(myarray(), 1), 3), Cells(UBound(myarray(), 1), 3)).Value = myarray()
      End If
    .ClearContents
    End With
  Set rng = Nothing
  out_time = Now() - st
End Sub
こんな感じに・・・(これで速度は上がっています、Test3より速い)。

全部載せると長くなるので、でれすけさんのコードだけテスト用に変更したものを
記述します。
'=======================================================
Sub test7(out_time, cnt)
  st = Now()
  Dim target As Range
  Dim i As Integer, ret
  Application.ScreenUpdating = False
  Set target = Range("A1:A" & cnt)
  For i = 1 To cnt
   If IsError(Application.Match(i, target, False)) Then
    Cells(j + 1, 8).Value = i
    j = j + 1
    End If
   Next
  Application.ScreenUpdating = True
  out_time = Now() - st
End Sub

これをAsakiさんがおっしゃっているように並べ替えも行うコードは
以下のコードで実行してみました。

'==================================================================
Sub test8(out_time, cnt)
  st = Now()
  Dim target As Range
  Dim i As Integer, ret
  Dim ok As Boolean
  Application.ScreenUpdating = False
  Set target = Range("j1:j" & cnt)
  With target
   .Value = Range("a1:a" & cnt).Value
   .Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    :=xlPinYin
   For i = 1 To cnt
    ret = Application.Match(i, target, 1)
    ok = False
    If IsError(ret) Then
      ok = True
    ElseIf .Cells(ret).Value <> i Then
      ok = True
      End If
    If ok Then
      Cells(j + 1, 9).Value = i
      j = j + 1
      End If
     Next
   .ClearContents
   End With
  Application.ScreenUpdating = True
  out_time = Now() - st
End Sub

データ数10000、欠番数3661のとき、

前回までのTest1〜Test6の中では、

最速がTest5の「00:02:17」でした。

これに対し、Test7は「00:00:47」でソートなしでもかなり速い結果をだしています。

さらに、Test8は、「00:00:22」でした。

つんさんもAsakiさんも速度というキーワードがあれば、もっと違うコードの投稿を
されていたと思います。

いろんな手法でのコード、予想はできても中々確認までしていられなかったので
このご質問を利用して、いろんなサンプルコードで確認する事ができました。
皆さん、ありがとうございました。
2 hits

【16617】欠番を発見したい hisao 04/8/4(水) 11:02 質問
【16618】Re:欠番を発見したい つん 04/8/4(水) 11:20 回答
【16639】Re:欠番を発見したい Asaki 04/8/4(水) 17:53 回答
【16642】Re:欠番を発見したい Asaki 04/8/4(水) 19:41 発言
【16648】Re:欠番を発見したい ichinose 04/8/5(木) 8:49 発言
【16649】Re:欠番を発見したい でれすけ 04/8/5(木) 9:32 発言
【16652】Re:欠番を発見したい hisao 04/8/5(木) 10:44 お礼
【16653】イミディエイトウインドウ つん 04/8/5(木) 11:13 発言
【16654】Re:イミディエイトウインドウ でれすけ 04/8/5(木) 11:22 発言
【16656】Re:イミディエイトウインドウ hisao 04/8/5(木) 11:59 お礼
【16666】Re:イミディエイトウインドウ つん 04/8/5(木) 13:14 発言
【16668】Re:イミディエイトウインドウ Asaki 04/8/5(木) 13:15 回答
【16688】Re:イミディエイトウインドウ ichinose 04/8/6(金) 1:30 発言
【16691】Re:イミディエイトウインドウ 追伸 ichinose 04/8/6(金) 9:48 発言
【16693】Re:イミディエイトウインドウ hisao 04/8/6(金) 12:00 お礼

64624 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free