Excel VBA質問箱 IV

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

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


12345 / 13645 ツリー ←次へ | 前へ→

【10968】処理速度の向上について K.C 04/2/19(木) 23:17 質問
【10969】Re:処理速度の向上について りん 04/2/20(金) 7:49 発言
【10970】Re:処理速度の向上について ichinose 04/2/20(金) 8:02 発言
【10982】Re:処理速度の向上について Hirofumi 04/2/21(土) 17:57 回答
【10986】質問と別解 Hirofumi 04/2/21(土) 21:40 回答
【10988】Re:処理速度の向上について K.C 04/2/22(日) 0:46 お礼

【10968】処理速度の向上について
質問  K.C  - 04/2/19(木) 23:17 -

引用なし
パスワード
   いつも拝見させていただいております。
VBAで自分の思う結果は得られるようになったのですが、コードが良くないらしく処理速度に時間がかかり、悩んでいます。

例えば、以下のコードの処理速度を改善するにはどんな方法があるのでしょうか?

内容はA列に0・1・2・・・・200一様に増加する値が、B列には−0.5から205までの値が不等間隔かつ順不同で並んでいます。B列の数字を上から順に読み込んで、A列の連続な2つの値に挟まれたら、その挟んだA列の値の行番号+1をそれぞれC列に返すというものです。

一般的な処理速度完全方法でもいいので教えてくださる方、いましたら教えていただけると幸いです。よろしくお願いいたします。

Sub test()

Dim n, o, m, x, y, i As Double
n = Range("A1").End(xlDown).Row
o = Range("B1").End(xlDown).Row

For m = 1 To o

  x = Cells(m, 2)
st1:
  For i = 1 To n
  
    If Cells(i, 1) <= x And x <= Cells(i + 1, 1) Then
    y = i + 1
    
    GoTo st2
    
    ElseIf Cells(i, 1) > x And x > Cells(i + 1, 1) Then
    
    GoTo st1
    
    ElseIf Cells(1, 1) > x Then
    y = 2
    GoTo st2
    
    ElseIf Cells(n, 1) < x Then
    y = n
    GoTo st2
    
    End If
  Next
st2:

  Cells(m, 3).Value = y

Next

End Sub

【10969】Re:処理速度の向上について
発言  りん E-MAIL  - 04/2/20(金) 7:49 -

引用なし
パスワード
   K.C さん、おはようございます。

>VBAで自分の思う結果は得られるようになったのですが、コードが良くないらしく処理速度に時間がかかり、悩んでいます。
>一般的な処理速度完全方法でもいいので教えてくださる方、いましたら教えていただけると幸いです。よろしくお願いいたします。

時間がないのでヒントだけ。
配列を使って処理速度が大幅短縮
http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=7715;id=Excel

【10970】Re:処理速度の向上について
発言  ichinose  - 04/2/20(金) 8:02 -

引用なし
パスワード
   ▼K.C さん:
おはようございます。
処理速度を上げる方法はあると思いますが、それは別の方におまかせするとして・・。
このコードで疑問があったので質問です。

>Sub test()
>
>Dim n, o, m, x, y, i As Double
>n = Range("A1").End(xlDown).Row
>o = Range("B1").End(xlDown).Row
>
>For m = 1 To o
>
>  x = Cells(m, 2)
>st1:
>  For i = 1 To n
>  
>    If Cells(i, 1) <= x And x <= Cells(i + 1, 1) Then
>    y = i + 1
>    
>    GoTo st2
>    
>    ElseIf Cells(i, 1) > x And x > Cells(i + 1, 1) Then
'       このIF文にひっかかるcells(i,1)という値の一例を教えて下さい
'       ここに入ってくるcells(i,1)って存在しないのではないですか?
'       もしかして、Andではなくて、Orですか?
'       でも、そうだとしたらこれループしっぱなしになってしまいますよ。
>    
>    GoTo st1
>    
>    ElseIf Cells(1, 1) > x Then
>    y = 2
>    GoTo st2
>    
>    ElseIf Cells(n, 1) < x Then
>    y = n
>    GoTo st2
>    
>    End If
>  Next
>st2:
>
>  Cells(m, 3).Value = y
>
>Next
>
>End Sub
それから、Goto文を否定するわけではないのですが、
上のコード、Goto文を入れない方が見やすいコードになりませんか?

【10982】Re:処理速度の向上について
回答  Hirofumi E-MAIL  - 04/2/21(土) 17:57 -

引用なし
パスワード
   概ね、こんな形で元のコードと同じ様に出力しているみたいだけど
元のコードのロジックが何か変な気がします
通常は、何々以上何々未満若しくは、何々を超え何々以下の様な形に成るのに
何々以上何々以下に成っている為、最小値と最大値の行き先が変?

Public Sub Test2()

  Dim i As Long
  Dim rngScope As Range
  Dim vntKeys As Variant
  Dim vntResult As Variant
  
  Set rngScope = Range(Cells(1, "A"), Cells(65536, "A").End(xlUp))
  vntKeys = Range(Cells(1, "B"), Cells(65536, "B").End(xlUp)).Value
  ReDim vntResult(1 To UBound(vntKeys, 1), 1 To 1)
  
  For i = 1 To UBound(vntKeys, 1)
    vntResult(i, 1) = Application.Match(vntKeys(i, 1), rngScope, 1)
    If IsError(vntResult(i, 1)) Then
      vntResult(i, 1) = 2
    Else
      If vntKeys(i, 1) <> rngScope(vntResult(i, 1)) Then
        If vntResult(i, 1) + 1 <= rngScope.Rows.Count Then
          vntResult(i, 1) = vntResult(i, 1) + 1
        End If
      End If
    End If
  Next i
  Set rngScope = Nothing
  
  Cells(1, "C").Resize(UBound(vntKeys, 1)).Value = vntResult
  
End Sub

【10986】質問と別解
回答  Hirofumi E-MAIL  - 04/2/21(土) 21:40 -

引用なし
パスワード
   これ、どちらが正解なのかな?

>    ElseIf Cells(1, 1) > x Then
>    y = 2
>    GoTo st2

    ElseIf Cells(1, 1) > x Then
    y = 1
    GoTo st2

もし、y = 1 が正しいなら前のコードの以下の部分を修正して下さい

    If IsError(vntResult(i, 1)) Then
      vntResult(i, 1) = 2
    Else



    If IsError(vntResult(i, 1)) Then
      vntResult(i, 1) = 1
    Else

にして下さい

また、質問のコードに近い形でコードを書くといかの様に成ります
比較元(B列)、比較先(A列)を配列に取り込み、結果も配列に書き出して
シートに出力しています

Public Sub Test4()

  Dim i As Long
  Dim j As Long
  Dim vntScope As Variant
  Dim vntKeys As Variant
  Dim vntResult As Variant
  
  vntScope = Range(Cells(1, "A"), _
          Cells(65536, "A").End(xlUp)).Value
  vntKeys = Range(Cells(1, "B"), _
          Cells(65536, "B").End(xlUp)).Value
  ReDim vntResult(1 To UBound(vntKeys, 1), 1 To 1)
  
  For i = 1 To UBound(vntKeys, 1)
    For j = 1 To UBound(vntScope, 1) - 1
      If vntScope(j, 1) < vntKeys(i, 1) Then
        If vntKeys(i, 1) <= vntScope(j + 1, 1) Then
          vntResult(i, 1) = j + 1
          Exit For
        End If
      End If
    Next j
    If vntResult(i, 1) = "" Then
      If vntScope(1, 1) >= vntKeys(i, 1) Then
        vntResult(i, 1) = 1
'        vntResult(i, 1) = 2 'どちらが正解?
      Else
        vntResult(i, 1) = UBound(vntScope, 1)
      End If
    End If
  Next i
  
  Cells(1, "C").Resize(UBound(vntKeys, 1)).Value = vntResult
  
End Sub

【10988】Re:処理速度の向上について
お礼  K.C  - 04/2/22(日) 0:46 -

引用なし
パスワード
   りんさん
情報ありがとうございます。
目を通しましたが、なかなか難しいです。もう少し勉強してみたいと思います。

Ichinoseさん
>ElseIf Cells(i, 1) > x And x > Cells(i + 1, 1) Then
指摘の通りいらないですね・・・
また、gotoもない方がいいですね・・・

Hirofumiさん
>通常は、何々以上何々未満若しくは、何々を超え何々以下の様な形に成るのに
>何々以上何々以下に成っている為、最小値と最大値の行き先が変?
指摘の通りです。おかしいですね!「何々を超え何々以下」で実行したく考えていました。

これ、どちらが正解なのかな?

>    ElseIf Cells(1, 1) > x Then
>    y = 2
>    GoTo st2

y = 2が正解です。

みなさん、貴重なお時間をいただき私の質問にお答えいただきありがとうございました。
まだまだ、自分のコードをしっかり見直す必要性があることが良くわかりました。
簡単なミスが、処理時間を長くしている原因かもしれません。
周りに、質問できる人もいないので、他の人の意見を聞けて勉強になりました。
今回、皆さんにいただいたご指摘と、書き込んでいただいたコードを参考にもう一度、自分なりにコードを書いてみて、処理時間を比較してみたいと思います。
不備が多いにも関わらず、親切な対応本当にありがとうございました。
また、今後もなにかありましたら、ご指導の方お願いいたします。

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