エクセルでVBAを使ってプログラム書くと、If文の条件分岐式をよく使います。
もし、何々だったらする/しないで条件を付けて処理行しますが、必要不可欠だ。
なので、この構文は覚える必要がありますが、他の条件分岐式も存在するんだ。
それが、Select Caseですが、これは条件を満たす場合が、複数の時に便います。
まあ、"Case 1 To 3, Is >= 10"のように、範囲、以上をOrでつなげられるな。
こういった複雑な条件定義は便利ですが、ネスト（入れ子）のコードも容易ね。
つまり、もし何々ならば、そして何々であるのならこうせよといった論理展開。
条件分岐第一段階の下に、もう一度条件分岐が入るから入れ子なのででしょう。
それで、こういった複雑な条件付けで検索、抽出もできるのではとひらめいた。
３つくらい検索条件を掛けて抽出する式を考えてみましたがサンプルが必要だ。
たまさか、”E for Excel”というサンプルデータのサイトがあり、ダウンロード。
五十万行のセールスレコードを入手して、プログラムを書いたので紹介します。
検索の条件は、B列の”Japan”を見つけ、次にJ列の”単価”が100以上で300以下。
これを、Select CaseとIfの両方の条件分岐式で書きましたが、If文は初の試み。
どちらかと言うと、Slect Case文の方が書きやすいのと条件が複雑にできそう。
実をいうと、今までコマンドのFindとか配列を使った検索の手法を用いました。
だけど、使い方では、このような条件分岐式を使った検索でも応用できそうだ。
五十万行から千二百行の抽出に上記の条件で検索した結果、十数秒ほどだった。
というわけで、If文よりは記述しやすそうな、Select Case文はお勧めしたいな。
今回の投稿で、条件分岐式として””Select Case”を、どのようにまとめようかと悩んだのですが、複雑な条件づけがIf文より書きやすいのと、検索の条件設定などが、Findなどの検索コマンドより理解しやすいのに気が付いて、紹介することにしたのでした。
＜参考コード＞
※50万行のデーが、"Sheet1"にあり検索結果を"Sheet2"に書く条件とします。
Sub tmp() 'Select Case の参考コード
Dim i As Long, j As Long
Application.ScreenUpdating = False
j = 1
For i = 2 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row Step 1
Select Case Worksheets("Sheet1").Range("B" & i).Value
Case "Japan"
Select Case Worksheets("Sheet1").Range("J" & i).Value
Case Is > 100
Select Case Worksheets("Sheet1").Range("J" & i).Value
Case Is < 300
Worksheets("Sheet1").Range("A" & i & ":N" & i).Copy
Worksheets("Sheet2").Range("A" & j).PasteSpecial
j = j +1 ’シート2に書き込むとき、行番号を一つずつ増やす
End Select ’入れ子の条件掘り下げに注意
End Select
End Select
Next i
Application.ScreenUpdating = True
End Sub
Sub tmp() 'If Then文の参考コード（難しいな）
Dim i As Long, j As Long
Application.ScreenUpdating = False
j = 1
For i = 2 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row Step 1
If Worksheets("Sheet1").Range("B" & i).Value = "Japan" Then
If Worksheets("Sheet1").Range("J" & i).Value > 100 Then
if Worksheets("Sheet1").Range("J" & i) = < 300 Then
Worksheets("Sheet1").Range("A" & i & ":N" & i).Copy
Worksheets("Sheet2").Range("A" & j).PasteSpecial
j = j + 1
End If
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
0 件のコメント:
コメントを投稿