中小企業の働き方改革をサポート>>

エクセル VBA Select case の繰り返し処理がうまくいきません。

セルB5に条件となる文字列(AAA、BBB、CCC...)があり、
セルC5にAAAなら10、BBBなら20、CCCなら30といった具合に出力し、
セルB6⇒C6、B7⇒C8と順々にセルB50⇒C50まで続けて処理したいのですがどのように対処すればよろしいでしょうか?

For~Nextを使って繰り返し処理したいのですが、お分かりの方がいればご教授のほどよろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (5件)

こんな感じでしょうか?



Sub testセレクトケース()
  Dim val As Variant
  Dim r As Range
  
  For Each r In Range("B5:B50")
    Select Case r.Value
      Case "AAA": val = 10
      Case "BBB": val = 20
      Case "CCC": val = 30
    End Select
    r.Offset(, 1).Value = val
  Next
End Sub
    • good
    • 0
この回答へのお礼

ご回答くださいましてありがとうございます。
やりたいことを完璧に再現してくださいました!!

あとは、
セルB5が空白又は条件候補以外の文字列が入力されているときに
セルC5に???を出力させる方法と
セルB5が50まで固定の処理ではなくて、B列に入力されている分
(例えばセルB30までならセルC30まで出力、B40までならC40まで出力)
だけ処理する方法を探していきます。

お礼日時:2008/10/13 10:53

ANo.1です。



検索条件とその値がE列・F列の1行目からあるとします。

Sub test()
Dim Dic As Object
Dim r As Range
Dim i As Long
Dim v As Variant, vv As Variant

Set Dic = CreateObject("Scripting.Dictionary")

With Worksheets("Sheet1")
v = .Range(.Range("E1"), .Cells(Rows.Count, 6).End(xlUp)).Value

For i = 1 To UBound(v, 1)
Dic(v(i, 1)) = v(i, 2)
Next

For Each r In .Range("B5", .Cells(Rows.Count, 2).End(xlUp))

If Dic.Exists(r.Value) Then
vv = Dic(r.Value)
Else
vv = "???"
End If
r.Offset(, 1).Value = vv

Next
End With

Set Dic = Nothing
Erase v
End Sub

VLOOKUP関数の身代わりとして下さい。。。
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。

提示していただいたマクロですが、当方のスキル不足により
十分に活用することが出来ず大変申し訳なく思っています。

今回質問させていただいた疑問点は、他の方の回答により
無事解決することが出来ました。

今後、私自身のスキルアップを図り、別の機会にて活用させて
いただきたく思います。

丁寧にご指導いただきまして誠にありがとうございました。

お礼日時:2008/10/14 12:42

こういう問題は、IF文的発想でやることを、経験をつんで、早く脱却しないと進歩は無い。


IF
CASE(IFの亜種)
VLOOKUPやMATCH(VBAでの関数利用)
表引き
Findメソッド
レコードの検索構造化(本質問には関係ないが、レコードの探索)
SQL(本質問には関係ないが)
などを思いつく。
ーー
VLOOKUPの例
例データ E1:F3
AAA10
BBB20
CCC30
ーー
B5:C11
AAA10
CCC30
BBB20
AAA10
BBB20
AAA10
CCC30
コード
Sub test01()
d = Range("B65536").End(xlUp).Row
For i = 5 To d
Cells(i, "C") = WorksheetFunction.VLookup(Cells(i, "B"), Range("E1:F3"), 2, False)
Next i
End Sub
MATCH関数の場合、上記のWorksheetFunction.VLookupの行が
x = WorksheetFunction.Match(Cells(i, "B"), Range("E1:E3"), 0)
Cells(i, "C") = Cells(x, "F")
ーー
表引きは
Sub test02()
d = Range("B65536").End(xlUp).Row
For i = 5 To d
For j = 1 To 3
If Cells(i, "B") = Cells(j, "E") Then
Cells(i, "C") = Cells(j, "F")
GoTo p1
End If
Next j
Cells(i, "C") = "Not Found"
p1:
Next i
End Sub
のようなもの。
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。

提示していただいたマクロですが、当方のスキル不足により
十分に活用することが出来ず大変申し訳なく思っています。

今回質問させていただいた疑問点は、他の方の回答により
無事解決することが出来ました。

今後、私自身のスキルアップを図り、別の機会にて活用させて
いただきたく思います。

丁寧にご指導いただきまして誠にありがとうございました。

お礼日時:2008/10/14 12:47

ANo.1です。



ちなみにVLOOKUP関数案は、表を作成しておけばデータの変更はコードではなくシート上の表でできるので、
多いのなら楽かと思いまして。
数式を入れるのが何でしたらVBAで表を参照すれば宜しいかと。

未熟者の浅知恵程度として下さい。
    • good
    • 0

>条件となる文字列(AAA、BBB、CCC...)があり、


条件は3つなのですか、それとも多くて固定?or変動?

多いのなら表を作成してVLOOKUP関数でやるとか。
    • good
    • 0
この回答へのお礼

条件は500以上あり、WEBから表を読み込んで自動で表作成しています。
作成した表にはAAA,BBB,CCCと明記されておらず、
VLOOKUP関数では表から値をうまく抽出できないと思い、
今回は Select Caseで表から値を抽出する方法を採りました。
VLOOKUP関数でも代用可能でしたら、別の方法も試してみたいと思います。

ありがとうございました。

お礼日時:2008/10/13 21:27

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QExcel VBAで複数シートをコピーする

Excel VBAで複数のシートを新たらしいブックにコピーする方法が分かりません。

一応、Selectで全てのシートを選択し
コピーする方法は分かるのですが
出来ればSelectなどの画面遷移をプログラム内に含ませたくありません

シートは n件存在します。
ご存知の方がおられましたら
ぜひ、教えて頂けないでしょうか?

Aベストアンサー

すいません、勉強不足でした。
ただ単純に「全てのシートを選択」し「新規ファイルにコピー」という動作であれば、
sheets.Select
sheets.Copy
だけでできました。

QSelect Case文でこのようなことは可能でしょうか?

こんにちは。
「Select Case」の条件の一つに、文字列で○○を含むというのは指定できるのでしょうか?

例えば・・・

Select Case strName
Case "ABC"
処理1
Case "D"を含む
処理2
Case Else
処理3
End Select

上記の様なことがしたいのですが、可能でしょうか?
可能でしたら、「"D"を含む」の部分はどのように書いたらいいですか??
教えてください。宜しくお願いしますm(_ _)m

Aベストアンサー

> 文字列で○○を含むというのは指定できるのでしょうか?

Caseの中ではNGです。

Select Case strName
Case "ABC"
処理1
Case Else
 if strNameがDを含むなら、 then
  処理2
 Else
  処理3
 Endif
End Select

とかですね。


> 「"D"を含む」の部分はどのように書いたらいいですか??

InStr関数を利用するのが良いです。

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QエクセルVBAのIf,Then 構文でOr条件とAnd条件の結合方法?

ワークシート関数で書けば
=IF(OR(F18=0,AND(F15>0,F16>0)),TRUE)です。
これをVBAで書こうとして

If Sheet1.Range("F18") = 0 Or Sheet1.Range("F15") > 0 And Sheet1.Range("F16") > 0 Then
MsgBox True
Else
MsgBox False
End If

とやってみたのですが、正しくないようです。
どのように書けばいいのでしょうか?

Aベストアンサー

>とやってみたのですが、正しくないようです。

式は正しいと思いますよ

ANDとORは、ANDが先に演算されます。/*と+-では、/*が先に演算されるようなものです。

でも、わかり易くするために、#1のかたのように括弧をつけるほうが良いですね。

Qexcel マクロ 「select case」への条件盛り込み方法について

初めまして。

仕事にて、EXCELに工程遅延の原因を記入しているのですが、
同じ理由(約50種類あります)を何度も記入する必要があるため、
理由ごとに番号を割り振って、ボタン一つで記入できるようにしたいと思っています。

そこで、下記のようにマクロを作成してみたのですが、
現状では、例えばCells(1, 1)に何かを特記していた場合、
記入後にこのマクロを実行してしまうと、Cells(1, 1)の特記が、
上書きにより消えてしまいます。

そこで、Cells(num, 1)が空白であれば、Cells(num, 1)に上書きする、
という条件を付加したいのですが、可能でしょうか。

EXCELマクロの本を参考に作成しているのですが、
組み合わせの方法が分かりません。

お時間がある方いらっしゃいましたら、
ご検討よろしくお願い致します。

Sub 理由挿入()
Dim num As Integer
For num = 1 To 100
Select Case Cells(num, 2).Value
Case 1
Cells(num, 1).Value = "理由1"
Case 2
Cells(num, 1).Value = "理由2"
Case 3
Cells(num, 1).Value = "理由3"
Case 4
Cells(num, 1).Value = "理由4"
End Select
Next
End Sub

初めまして。

仕事にて、EXCELに工程遅延の原因を記入しているのですが、
同じ理由(約50種類あります)を何度も記入する必要があるため、
理由ごとに番号を割り振って、ボタン一つで記入できるようにしたいと思っています。

そこで、下記のようにマクロを作成してみたのですが、
現状では、例えばCells(1, 1)に何かを特記していた場合、
記入後にこのマクロを実行してしまうと、Cells(1, 1)の特記が、
上書きにより消えてしまいます。

そこで、Cells(num, 1)が空白であれば、Cells(num, 1)に上書きす...続きを読む

Aベストアンサー

Sub 理由挿入()
Dim num As Integer
For num = 1 To 100
If Cells(num, 1).Value = "" Then
Select Case Cells(num, 2).Value
Case 1
Cells(num, 1).Value = "理由1"
Case 2
Cells(num, 1).Value = "理由2"
Case 3
Cells(num, 1).Value = "理由3"
Case 4
Cells(num, 1).Value = "理由4"
End Select
End If
Next
End Sub
でいいんじゃないか。

QVBA コンボボックスで選んだ値を取得するには

ユーザーフォーム上のコンボボックスから値を選択し、その値を変数として使いたいのですが、うまくいきません。

コンボボックスのコードで
Private Sub ComboBox1_Change()
moji1 = ComboBox1.Text
Range("A1").Value = moji1
のようにすれば、コンボボックスから値を選んだ時点でA1セルにその値をコピーできるのですが、同じユーザーフォーム上にあるコマンドボタンをクリックして実行する「マクロ1」にてこのmoji1という変数を使いたいのです。

マクロ1にて、上記と同じ
Range("A1").Value = moji1
というコードを記述しても、ユーザーフォームで選択した値が消えており、empty値となってしまいます。

原因をご存知の方はお教えください。

Aベストアンサー

原因については下記を参考にしてください。
http://pc.nikkeibp.co.jp/pc21/special/2007_gosa/eg5.shtml


人気Q&Aランキング

おすすめ情報