エクセルのマクロ。セルの値により複数条件分岐を

質問

皆様　よろしくお願いします。
エクセルで社内で使っている現金出納帳がありまして。

D6セルから下方向に数字・日本語アルファベット混在して
入力されています。
例「1月13日　現金売上」　「2月13　切手代」　「3月31日　食事料金」
といった具合です。

そのセルの内容を判断して
G6セルから下方向に
該当する数字を書きこむべく
以下のようなマクロを作っています。
条件はもっと増えてきた場合に
一個一個条件を書き足すと膨大なマクロになってくると思いまして
スマートな書き方がございましたら
ご指導くださると助かります。

Sub 科目自動入力()

Dim a As Integer
a = 6

'内容が空白になるまで繰り返す
Do Until Cells(a, 4).Value = ""

'「売上」が含まれていたら700
If Cells(a, 4).Value Like "*売上*" Then Cells(a, 7).Value = 700

'「切手」もしくは「レター」が含まれていたら756
If Cells(a, 4).Value Like "*切手*" Or Cells(a, 4).Value Like "*レター*" Then Cells(a, 7).Value = 756

'「残業」もしくは「食事」が含まれていたら746
If Cells(a, 4).Value Like "*残業*" Or Cells(a, 4).Value Like "*食事*" Then Cells(a, 7).Value = 746

'「旅費」もしくは「交通費」が含まれていたら755
If Cells(a, 4).Value Like "*旅費*" Or Cells(a, 4).Value Like "*交通費*" Then Cells(a, 7).Value = 755

a = a + 1

Loop

End Sub

回答No.2

kagakusuki · ベストアンサー

次の様にされては如何でしょうか。

Sub 科目自動入力()

Dim a As Long, myArray As Variant, i As Long

myArray = Array("売上", 700, "切手", 756, "レター", 756, "残業", 746, "食事", 746, "旅費", 755, "交通費", 755)

a = 6
'内容が空白になるまで繰り返す
Do Until Cells(a, 4).Value = ""

For i = 0 To UBound(myArray) - 1 Step 2
If Cells(a, 4).Value Like "*" & myArray(i) & "*" Then Cells(a, 7).Value = myArray(i + 1)
Next i

a = a + 1
Loop

End Sub

お礼

ご回答ありがとうございました、
配列を使った方法　とっても参考になりました。

回答No.5

mt2015

項目が後から増えたり減ったりするなら、項目とデータを一覧にしてその一覧を参照するようにした方がいいです。
以下のサンプルではJ4:K20を一覧として使用する例です。

Sub Sample()
　　　Dim a As Integer
　　　a = 6
　　　aList = Range("J4:K20")

　　　'内容が空白になるまで繰り返す
　　　Do Until Cells(a, 4).Value = ""
　　　　　　'一覧に空白が出るか、一致する項目があるまで繰り返す
　　　　　　For i = 1 To UBound(aList)
　　　　　　　　　If aList(i, 1) = "" Then Exit For
　　　　　　　　　If Cells(a, 4).Value Like "*" & aList(i, 1) & "*" Then
　　　　　　　　　　　　Cells(a, 7).Value = aList(i, 2)
　　　　　　　　　　　　Exit For
　　　　　　　　　End If
　　　　　　Next i
　　　　　　a = a + 1
　　　Loop
End Sub

お礼

ありがとうございます、
シートに項目とデータを書いておけば
今後の更新においてマクロを書き換えなくても
すむのですね　勉強になりました

回答No.4

f272

こんな感じでどうでしょう。
Sub hogehoge()
With Range("D6", Range("D" & Rows.Count).End(xlUp)).Offset(, 3)
.Formula = "=LOOKUP(0,0/FIND($A$6:$A$12,D6),$B$6:$B$12)"
End With
End Sub
A列とB列の6行目から12行目には
売上 700
切手 756
レター 756
残業 746
食事 746
旅費 755
交通費 755
が書かれていることが前提です。

お礼

ありがとうございます
VLOOKUPとマクロを組み合わせての方法
勉強になりました。

回答No.3

mshr1962

Sub 科目自動入力()

Dim a As Integer
Dim x As Integer
a = 6

'内容が空白になるまで繰り返す
Do Until Cells(a, 4).Value = ""
x = 0
Select Case Cells(a, 4).Value
Case is like "*売上*"
x = 700
Case is like "*切手*"
x = 756
Case is like "*レター*"
x = 756
Case is like "*残業*"
x = 746
Case is like "*食事*"
x = 746
Case is like "*旅費*"
x = 755
Case is like "*交通費*"
x = 755
End Select
Cells(a, 7).Value = x
a = a + 1

Loop

End Sub

お礼

ご回答ありがとうございます、
未熟なせいか
ためしてみてうまくつかいこなせませんでしたが
勉強していきたいとおもいます

回答No.1

ushi2015

こんにちは
スマートかどうかは別として、こんな感じで、
Sub test1()
　　With Range("D6", Range("D" & Rows.Count).End(xlUp)).Offset(, 3)
　　　　.Formula = "=IF(ISERROR(FIND(""売上"",$D6,1))," & _
　　　　　　　　　　"IF(ISERROR(FIND(""切手"",$D6,1))," & _
　　　　　　　　　　"IF(ISERROR(FIND(""レター"",$D6,1))," & _
　　　　　　　　　　"IF(ISERROR(FIND(""残業"",$D6,1))," & _
　　　　　　　　　　"IF(ISERROR(FIND(""食事"",$D6,1))," & _
　　　　　　　　　　"IF(ISERROR(FIND(""旅費"",$D6,1))," & _
　　　　　　　　　　"IF(ISERROR(FIND(""交通費"",$D6,1))," & _
　　　　　　　　　　"0," & _
　　　　　　　　　　"755)," & _
　　　　　　　　　　"755)," & _
　　　　　　　　　　"746)," & _
　　　　　　　　　　"746)," & _
　　　　　　　　　　"756)," & _
　　　　　　　　　　"756)," & _
　　　　　　　　　　"700)"
　　　　.Value = .Value
　　End With
End Sub
Sub test2()
　　Dim v(1 To 7, 1 To 2)
　　Dim r As Range
　　Dim i As Long
　　Dim j As Long
　　Dim d As Range
　　Dim g As Variant
　　v(1, 1) = "売上":　　v(1, 2) = 700
　　v(2, 1) = "切手":　　v(2, 2) = 756
　　v(3, 1) = "レター": v(3, 2) = 756
　　v(4, 1) = "残業":　　v(4, 2) = 746
　　v(5, 1) = "食事":　　v(5, 2) = 746
　　v(6, 1) = "旅費":　　v(6, 2) = 755
　　v(7, 1) = "交通費": v(7, 2) = 755
　　Set d = Range("D6", Range("D" & Rows.Count).End(xlUp))
　　g = d.Offset(, 3).Value
　　For Each r In d
　　　　j = j + 1
　　　　For i = 1 To UBound(v, 1)
　　　　　　If InStr(1, r.Value, v(i, 1)) > 0 Then
　　　　　　　　g(j, 1) = v(i, 2)
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　Next
　　d.Offset(, 3).Value = g
End Sub
２番目のコードの変数ｖは書き方を変えて、セル上のデータをセットする事も
出来ます。
条件が増えた場合にコードを修正するか、セル上にセットした条件を追加するか
どちらがいいかによります。

お礼

2種類も回答を下さってありがとうございます。
両方とも今後の参考にさせてください。