エクセルVBAで不規則な条件に合致する場合のコードの記述方法

このQ&Aのポイント
  • エクセル2002 VBAで、A列に不規則な値が存在し、その値に合致する場合にB列の処理をしたい場合、どのようにコードを記述するかを教えてください。
  • 質問者は、If文の中でorを用いて全ての条件を記述するか、またはElseIfでつなぐ方法しか思いつかないと述べています。
  • 現実には50個ほどの条件を検出したいため、どのようにコードを記述すれば効率的かをアドバイスしてください。
回答を見る
  • ベストアンサー

エクセルVBA 不規則な条件に合致する場合

エクセル2002 VBA での質問です。 A列に100~9999の数値データが不規則に存在しており、 105 108 113 114 121 531 553 2160 ・・・・・ のような不規則な値と合致するときに B列の処理をしたい場合のコードはどのように記述しますか? 私は for MyRow=1 to (最終行) if (cells(MyRow,1) =105 or cells(MyRow,1) =108 or cells(MyRow,1) =113 ・・・) then B列の処理 end if next MyRow のように If文 のなかで or を用いて全てを記述するかElseif でつなぐ方法しか思いつきません。 抽出対象の値は今後メンテナンスする必要はないのでコード内に記述しても構わないのですが or  や ElseIf を多用するのもどうかと思っています。 ※現実には50個ほどの条件での合致を検出したいです。 みなさんならどのように記述されるでしょうか?

質問者が選んだベストアンサー

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.4

作成例: sub Excelに出来ることはExcelにやらせる()  dim a as variant  dim i as long  a = array(105, 108, 113, 114, 121, 531, 553, 2160)  range("1:1").insert  range("A1").resize(1, ubound(a)+1) = a  with range("B2:B" & range("A65536").end(xlup).row)   .formula = "=IF(COUNTIF($1:$1,A2),""○"","""")"   .value = .value  end with  range("1:1").delete shift:=xlshiftup end sub 作成例: sub マクロの中でゴリゴリやらせる()  dim a as variant  dim i as long  dim j as long  a = array(105, 108, 113, 114, 121, 531, 553, 2160)  for i = 1 to range("A65536").end(xlup).row   for j = 0 to ubound(a)    if cells(i, 1) = a(j) then     cells(i, 2) = "○"     exit for    end if   next j  next i end sub

Sinogi
質問者

お礼

ご回答ありがとうございます。 二つも例示していただき感激です。 特に Excelに出来ることはExcelにやらせる()での ワークエリアとして行挿入&削除 や .value = .value のような一見しただけでは何をしているのかわからないコードの意味を読めたときは感動してしまいました。 ゴリゴリやるのはループの入子で、まさにゴリゴリを感じてしまいます(^^)

その他の回答 (4)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.5

>B列の処理をしたい場合 の処理とは何?プログラムのコードの中ではないのだから、処理とは、同行のB列値を取るのではないのか? あいまい。 値を取るならエクセルの常識関数VLOOKUPが使えるのでは。VBAでも使えるよ。 Sub test02() Dim x As Integer x = InputBox("コード") MsgBox x With ActiveSheet y = Application.WorksheetFunction.VLookup(x, .Range("A1:B3"), 2, False) MsgBox y End With End Sub ーーーーーーーーー モジュールのルーチン名(文字列)を得て、そのルーチンを実行するのは出来るかな?無理?

Sinogi
質問者

お礼

ご回答ありがとうございます。 >B列の処理をしたい場合 の処理とはデータクリア(セルを空白セルにする)したいのですが、今後は演算処理が要求されそうでもあります。 今後もご教示をお願いします

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.3

こんばんは! 色々やり方はあると思いますが、 IF・・・ OR IF・・・ と続けても大変ですので、 一例です。 Sheet2のA列に合致(検索)データを入力しておきます。 その上で↓のコードのような感じではどうでしょうか? Sub test() Dim i As Long Dim ws As Worksheet Set ws = Worksheets(2) Application.ScreenUpdating = False For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If WorksheetFunction.CountIf(ws.Columns(1), Cells(i, 1)) Then Cells(i, 2) =「B列の処理」 End If Next i Application.ScreenUpdating = True End Sub 参考になりますかね?m(_ _)m

Sinogi
質問者

お礼

ご回答ありがとうございます。 ワークシート関数の Countif で一致確認をするのは、案外すっきりしたコマンドですね。 WorksheetFunction. って冗長な気がしていたのですが実例を教えていただくと活用する気になってきます。

  • 11zep
  • ベストアンサー率36% (48/133)
回答No.2

私なら合致の結果を返すFunctionを作成します。 そして照合する値を配列に格納してFor Next文で配列の数分 ループさせる方法をとります。可読性が良くなるのが好きなので。 以下のサンプルは、Excel2007で作成しています。 呼び出し元: If ValExist(Cells(myRow,1) Then   一致した処理 Else   一致する値がない場合の処理 End If Private Function ValExist(Atai As String) As Boolean   Dim MyValue() As String   Dim Cnt As Integer   MyValue = Split("105,110,120,125", ",")   For Cnt = 0 To UBound(MyValue)     If Atai = MyValue(Cnt) Then      ValExist = True      Exit For     End If   Next Cnt End Function

Sinogi
質問者

お礼

ご回答ありがとうございます。 UBoundのコマンドは知らなかったので勉強になります。 Splitで配列にして、その要素数をUBoundで取得するのですね。 その配列に一致すればFunctionがTrueを返す。 応用できるようにがんばります(^^) 

  • mar00
  • ベストアンサー率36% (158/430)
回答No.1

Select Caseを使う手もあると思います。 Select Case Range("A" & MyRow) Case 113 To 118, 150 To 200 B列の処理 End Select とか Select Case Range("A" & MyRow) Case Is > 150 B列の処理 End Select などのように。

Sinogi
質問者

お礼

ご回答ありがとうございます。 or を , にするだけでもずいぶんすっきりしますね

関連するQ&A

  • VBAでorを使用しているときの合致条件

    お世話になります。 vbaで、下記の様なif文があるときに、 iは、1,2,3のどれで合致しているか判別する方法はありますか? 現在は、下記のように処理(1)を繰り返し、書いているのを 一度で済ませたいと思っています。 -------現在---------------- if i=1 then '処理(1) 'iの値が1の時の処理 elseif i=2 then '処理(1) 'iの値が2の時の処理 elseif i=3 then '処理(1) 'iの値が3の時の処理 endif ----------------------------------- ----------------理想--------------------------- if i=1 or i=2 or i=3 then '処理(1) ★★ここの時点でiの値を取りたい endif '処理で、iの値によって分岐 ------------------------------------------

  • エクセルのVBA、ループ処理について

    if文とループ処理をどう組み合わせればいいのかわかりません 以下のコードで、iの数をを増やしていく処理を行いたいのですが、エラーがでてしまいうまくいきません どのように書けばいいのでしょうか 教えてください For i = 2 To 11 If Cells("4,i") > 80 Then Cells("5,i").Value = "A" ElseIf Cells("4,i") > 70 Then Cells("5,i").Value = "B" ElseIf Cells("4,i") > 60 Then Cells("5,i").Value = "C" Else Cells("4,i").Value = "D" End If Next

  • エクセルVBAの質問です。

    次のようなマクロを作ったのですがエラーにはならないのですが、うまく働きません。 Else if の行が悪いと思うのですがどうなおせばいいのかわかりません。 どなたか教えてください、よろしくお願いします。 Sub 判定() Application.ScreenUpdating = False '処理中の表示をさせない lastrow = (Range("B4").End(xlDown).Row) 'B列の一番最後の行番号を代入 length(1) = Range("S2") For i = length(1) + 4 + 1 To lastrow If Cells(i - 1, 8) = "" And Cells(i - 1, 15) = "GC3" Or Cells(i - 1, 15) = "GC2" Then Cells(i, 8) = Cells(i, 2) * Cells(1, 5) + Cells(1, 7) ElseIf Cells(i - 1, 8) <> "" And Cells(i - 1, 15) = "DC3" Or Cells(i - 1, 15) = "DC2" Or Cells(i - 1, 15) = "DC1" Then Cells(i, 9) = Cells(i, 2) * Cells(1, 5) - Cells(1, 7) Else: Cells(i, 8) = Cells(i - 1, 8) End If     Next End Sub

  • VBAでelseに対応するifがありませんとエラー

    VBA初心者です 入力した数値(0から5)により、呼んでくる列を変えたいマクロを組んでいます if then elseif end ifで条件式を作ったのですが、 「elseに対応するifがありません」とエラーが出て進みません elseifが悪いのかと思い、条件を1つに絞ると上手く動きます(この際はendifは不要) ネット検索や参考書を見てますが、分かりません どなたか間違いを指摘して頂けませんか? Sub inputboxA() Dim nDat As String nDat = inputbox("何ヶ月目ですか?") If IsNumeric(nDat) = False Then MsgBox ("0から5までの値を入力して下さい") Exit Sub End If If nDat = 0 Then mm = 16 '0なら16列からデータを呼んでくる ElseIf nDat = 1 Then mm = 20 'ここでエラーが出る  1なら20列目からデータを呼んでくる ElseIf nDat = 2 Then mm = 24 '2なら24列目からデータを呼んでくる ElseIf nDat = 3 Then mm = 28 '3なら28列目からデータを呼んでくる ElseIf nDat = 4 Then mm = 32 '4なら32列目からデータを呼んでくる ElseIf nDat = 5 Then mm = 36 '5なら36列目からデータを呼んでくる End If 'データを呼んでくる For r = 4 To 2000 '処理するSheet1の行数範囲 b = Sheets(1).Cells(r, 1) 'bにA列の値を代入 For t = 6 To 2000 '検索するSheet3の行数範囲 If Sheets(3).Cells(t, 7) = b Then 'Sheet1のA列の値とSheet3のA列が一致した場合 y = Sheets(3).Cells(t, mm) 'yにB列の値を代入 Sheets(1).Cells(r, 6).Value = y 'Sheet1のB列に値を入力 Exit For '値が見つかったのでForを終了 End If Next Next End Sub

  • vba 記述をスマートにしたい

    お世話になります。 以下の記述をもっと簡略化させたいのですが、 列とシートが違うだけで、同じ処理を2回しているだけなので、 出来そうで、自分では出来ませんでした。 どなたかご教示頂きたく宜しくお願い致します。       記 Set myrngv = Workbooks("A.xls").Sheets("sheet1").Range("a:a") Set myrngYK = Workbooks("A.xls").Sheets("sheet1").Range("t:t") Set myrialz = Workbooks("A.xls").Sheets("sheet2").Range("b:b") Set myXBrialz = Workbooks("A.xls").Sheets("sheet3").Range("b:b") j = 3 Do j = j + 1 myhin = myrngv.Cells(j, 1).Value If myhin = "" Then Exit Do Set c = myrialz.Find(what:=myhin, Lookat:=xlWhole) If Not c Is Nothing Then firstaddress = c.Address Do myrow = c.Row myrngv.Cells(j, 9) = myrialz.Cells(myrow, 7).Value myrngv.Cells(j, 11) = myrialz.Cells(myrow, 8).Value myrngv.Cells(j, 13) = myrialz.Cells(myrow, 3).Value myrngv.Cells(j, 5) = myrialz.Cells(myrow, 3).Value + Cells(myrow, 7).Value - Cells(myrow, 8).Value Set c = myrialz.FindNext(c) Loop Until firstaddress = c.Address End If Loop 'ここより下が同じ様な処理 j = 3 Do j = j + 1 myhin = myrngYK.Cells(j, 1).Value If myhin = "" Then Exit Do Set c = myXBrialz.Find(what:=myhin, Lookat:=xlWhole) If Not c Is Nothing Then firstaddress = c.Address Do myrow = c.Row myrngYK.Cells(j, 8) = myXBrialz.Cells(myrow, 7).Value myrngYK.Cells(j, 10) = myXBrialz.Cells(myrow, 8).Value myrngYK.Cells(j, 12) = myXBrialz.Cells(myrow, 3).Value myrngYK.Cells(j, 6) = myXBrialz.Cells(myrow, 3).Value + Cells(myrow, 7).Value - Cells(myrow, 8).Value Set c = myXBrialz.FindNext(c) Loop Until firstaddress = c.Address End If Loop

  • エクセルVBA VLOOKUPについて

    エクセル VBA初心者です。 関数でのVLOOKUPをVBAで作りたいのですが、上手くいきません。 あらかじめ、Sheet2の1から300行までに A列  / B列 商品名 / 商品コード が入力されています。(名前の定義=商品コード) Sheet1にユーザーフォームを利用して、データを書き込んだ後、 B列に商品名が書き込まれると、 A列に商品コードが表示されるようにしたいと考えています。 A列に =IF(B2="","",VLOOKUP(B2,商品コード,2,FALSE)) と入力していたのですが、 VBAでIfを使って出来ないかと考えてみたのですが、 上手くいきませんでした。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sRow As Long Dim sColumn As Long sRow = ActiveCell.Row sColumn = ActiveCell.Column If Cells(sRow, 2).Value = True Then Cells(sRow, 1).Value = WorksheetFunction.VLookup(Cells(sRow2).Value, Worksheets("Sheet2").Range("A1:B300"), 2, False) ElseIf Cells(sRow, 2).Value = " " Then Cells(sRow, 1).Value = " " End If End Sub ご教授いただけないでしょうか? エクセル2003 WindowsXP

  • Excel VBAについて

    早速ですがExcelVBAについて質問です。 年齢がN列にあるとき、M列に年代を入れたいと思います。(例:19才なら10代、30才なら30代) 以下のように作成しましたが、すべてに20と入ったり正常に動作しないときがあります。 Excelは2003で作成していますが、いずれ2007でも使いたいです。 もっと正確に実行できるコードを教えてください。 ワークシート関数での解決は望んでいません。データ数も多く他の作業もマクロで処理するのでマクロを希望しています。よろしくお願いします。 -------------------------- Sub ByAge() Range("N1").Value = "年代別" Dim i As Long, N As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 13).Value >= 60 And Cells(i, 13).Value < 70 Then Cells(i, 14).Value = 60 ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then Cells(i, 14).Value = 50 ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then Cells(i, 14).Value = 40 ElseIf Cells(i, 13).Value >= 30 And Cells(i, 13).Value < 40 Then Cells(i, 14).Value = 30 ElseIf Cells(i, 13).Value >= 20 And Cells(i, 13).Value < 30 Then Cells(i, 14).Value = 20 End If Next i MsgBox "完了!" End Sub --------------------------

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート(作業中シート)に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ~??わからな~い??おしえてくださーい!! Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

  • ExcelのVBAで高さの設定

    どなたか教えて下さい。 報告書のフォーマットの作成をしています。 A列からE列までは日付や名前等の内容が入力されています。 F列にはそれに関するコメントが入力されています。 コメントの文字数は、少なければ10字程度、多ければ320文字程度あります。 文字数に合わせて高さを変更させたいです。 その為、以下のような事を行いました。 (1)G列にLEN関数を用いて、文字数を表示 (2)G列の文字数によって高さを変更させるVBAを作成 Sub Macro1() For i = 2 To 100 If Cells(i, 6) < 72 Then Rows(i).RowHeight = 80 ElseIf 73 < Cells(i, 6) < 108 Then Rows(i).RowHeight = 120 ElseIf 109 < Cells(i, 6) < 144 Then Rows(i).RowHeight = 160 ElseIf 145 < Cells(i, 6) < 180 Then Rows(i).RowHeight = 200 ElseIf 181 < Cells(i, 6) < 216 Then Rows(i).RowHeight = 240 ElseIf 217 < Cells(i, 6) < 252 Then Rows(i).RowHeight = 280 ElseIf 253 < Cells(i, 6) < 288 Then Rows(i).RowHeight = 320 ElseIf 289 < Cells(i, 6) < 324 Then Rows(i).RowHeight = 360 End If Next End Sub このVBAに記述間違いがあるようで、 「文字数が72文字以内であれば、高さを80に変更。 文字数が73文字以上で108文字未満であれば、高さは120」 までは認識し・高さの設定を行ってくれますが、108文字以上あっても高さは120になってしまいます。 どなたか教えて下さい。 よろしくお願い致します。

  • VBAの複数条件分岐について

    VBAで下記の構文を使用してシート1にある表より 条件に合致するもののみシート2に抽出するようにしています。 現在はシート1のE2セルの値がシート1のB列の値と比較して 該当するものを抽出しています。 この条件が、 シート1のE1のセルの値が20より小さい場合、 かつE2のセルの値がシート1のB列の値と比較して該当するものを シート1に貼り付け、 シート1のE1のセルの値が20以上の場合、 かつE2のセルの値がシート1のD列の値と比較して該当するものを シート1に貼り付ける というような条件に変えたいのですが どのように変更したらよろしいのでしょうか。 よろしくご教授下さい。 ちなみに現在使用している構文です。 これもきれいな構文かはわからないのですが・・・ Sub test() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") k = 1 sh2.Cells(k, "B") = sh1.Cells(1, "A") sh2.Cells(k, "C") = sh1.Cells(1, "B") k = k + 1 d = sh1.Range("A65536").End(xlUp).Row For i = 2 To d If sh1.Cells(i, "B") <= sh1.Range("E2") Then sh2.Cells(k, "B") = sh1.Cells(i, "A") sh2.Cells(k, "C") = sh1.Cells(i, "B") k = k + 1 End If Next i sh2.Activate End Sub

専門家に質問してみよう