[VBA]データ抽出がうまくいかないので教えてください

Question

前提・実現したいこと

VBAで値域[zmin,zmax]にあるデータを抽出したい

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

コンパイルは問題なくいくが、望む結果が得られておらず、どこが問題なのかもわからない

該当のソースコード

Sheets(sht_nm).Select
i = 5   
ii = 3   
While IsEmpty(Cells(i, 2).Value) = False
  If Cells(i, 2).Value > zmin And Cells(i, 2).Value < zmax Then
        xx = Cells(i, 1).Value
        zz = Cells(i, 2).Value
        Sheets("抽出データ").Select
        Cells(ii, 1).Value = xx
        Cells(ii, 2).Value = zz
        Sheets(sht_nm).Select
        ii = ii + 1
  End If
  i = i + 1
Wend

試したこと

sht_nm, 抽出データsheetは作ってあり、初期セル(cells(5,1), cells(5,2))にはちゃんとデータは入っています。しかし、実行すると抽出データsheetにはなにも出力されず、処理が終了してしまいます。理由はwhileのループの中にあると思うのですが、わからないので教えていただきたいです。

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

excelは2013ver.

Comments

[1T2R3M4]

zmin,zmaxはどこで定義してますか。

[MaryCocoon]

sht_nm = Application.InputBox("sheet名") zmin = Application.InputBox("最小値", "zmin") zmax = Application.InputBox("最大値", "zmax") を上述のソースコードの前にいれています

[hatena19]

その変数の宣言、代入も含めて、コード全体を提示してください。

Answer 1

VBAは型をある程度自動変換してくれますが、今回のケースは型をしっかり意識する必要があります。

例えば以下のコードを見てzminはv~にどんな結果（True/False）が入るか予想してみてください。

Private Sub VariantStringDoubleCompareTest()
    Dim zmin As Variant
    zmin = CVar("1") 'Variant型として扱わせる
    
    Dim v As Variant
    v = CVar(1) 'Variant型として扱わせる
    
    Dim zminはvより小さい As Boolean
    Dim zminはvと同じ As Boolean
    Dim zminはvより大きい As Boolean
    
    zminはvより小さい = (zmin < v)
    zminはvと同じ = (zmin = v)
    zminはvより大きい = (zmin > v)
    
    Stop 'ブレークポイント
End Sub

恐らく

変数	値
zminはvより小さい	False
zminはvと同じ	True
zminはvより大きい	False

となると予想されたかと思います。

では実際の結果を見てみると以下のようになります。
（結果の表示にはローカルウィンドウを使っています。メニューバー→表示→ローカル ウィンドウ）

このように、型を意識せず比較演算をすると、意図しない結果となることがあります。

---

今回の対処としては、zmin・zmax設定時のApplication.InputBoxの引数にTypeを指定し、数値のみ入力可能にしてあげると良いでしょう。

Office TANAKA - Excel VBA Tips[実は奥が深いInputBox]

---

蛇足

○○.Select及び、親のないCellsを使うと今どこで作業しているかがわかりにくくなってしまいます。

そのため、親のWorksheetを変数に取っておき、その変数経由で操作するとより堅牢になります。

ただ、親のWorksheetから辿ると記述が煩雑になる場合も多いため、さらに一歩進めて、Rangeそのものを扱う手もあります。

'Range操作メインにした場合

i = 5
ii = 3

'現在処理中のデータシート
Dim dataSheet As Worksheet
Set dataSheet = Sheets(sht_nm)

Dim currentDataCell As Range '=Cells(i, 1)
Set currentDataCell = dataSheet.Cells.Item(i, 1)

Dim v As Variant '= Cells(i, 2).Value
v = currentDataCell.Offset(, 1).Value


'「抽出データ」ワークシート
Dim extractSheet As Worksheet
Set extractSheet = Sheets("抽出データ")

Dim outputCell As Range 'Sheets("抽出データ").Range(Cells(ii, 1), Cells(ii, 2))
Set outputCell = extractSheet.Cells.Item(ii, 1).Resize(, 2)

Do Until IsEmpty(v)
    If zmin < v And v < zmax Then
        outputCell.Value = currentDataCell.Resize(, 2).Value
        Set outputCell = outputCell.Offset(1) 'ii = ii + 1
    End If
    Set currentDataCell = currentDataCell.Offset(1) 'i = i + 1
    v = currentDataCell.Offset(, 1).Value
Loop

Comments

[MaryCocoon]

imihito さん、ありがとうございました。
型の重要性とrangeを用いた方法、勉強になりました。
教えていただいたpgを精読して、より理解を深めたいと思います。
取り急ぎお礼申し上げます。ありがとうございました。

Answer 2

変数の宣言、型に間違いがなければ、そのロジックでいいと思います。

シートのSelectは遅くなるだけで不必要なので、使わない方法を覚えましょう。

Public Sub Test()
    Dim sht_nm As String
    Dim zmin As Long, zmax As Long
    Dim i As Long, ii As Long
    Dim xx, zz
    
    sht_nm = Application.InputBox("sheet名")
    zmin = Application.InputBox("最小値", "zmin")
    zmax = Application.InputBox("最大値", "zmax")
    
    i = 5
    ii = 3
    While IsEmpty(Sheets(sht_nm).Cells(i, 2).Value) = False
        zz = Sheets(sht_nm).Cells(i, 2).Value
        If zz > zmin And zz < zmax Then
            xx = Sheets(sht_nm).Cells(i, 1).Value
            Sheets("抽出データ").Cells(ii, 1).Value = xx
            Sheets("抽出データ").Cells(ii, 2).Value = zz
            ii = ii + 1
        End If
        i = i + 1
    Wend
End Sub

もっとスマートな書き方はありますが、
とりあえず元のコードを活かして書き換えてみました。

追記
imohitoさんがすでにスマートな書き方を回答されてました。(;^ω^)

Comments

[MaryCocoon]

hatena19 さん、ありがとうございました。
select sheetを使わないとこんなにも処理が速くなるのですね。驚きました。
今後変数の宣言をもっとしっかり理解してよりスマートな書き方を覚えていけるよう努力してまいります。
ありがとうございました。