excel2013 コードを短く

質問

Sub ab()

Application.ScreenUpdating = False

For Each c In Selection
If c.Value = "北海道" Then
c.Value = "01_北海道"
End If
If c.Value = "青森県" Then
c.Value = "02_青森県"
End If
If c.Value = "岩手県" Then
c.Value = "03_岩手県"
End If
If c.Value = "宮城県" Then
c.Value = "04_宮城県"
End If
If c.Value = "秋田県" Then
c.Value = "05_秋田県"
End If
If c.Value = "山形県" Then
c.Value = "06_山形県"
End If
If c.Value = "福島県" Then
c.Value = "07=福島県"
End If
If c.Value = "茨城県" Then
c.Value = "08_茨城県"
End If
If c.Value = "栃木県" Then
c.vlue = "09_栃木県"
End If
If c.Value = "群馬県" Then
c.Value = "10_群馬県"
End If
If c.Value = "埼玉県" Then
c.Value = "11_埼玉県"
End If
If c.Value = "千葉県" Then
c.Value "12_千葉県"
End If
If c.Value = "東京都" Then
c.Value = "13_東京都"
End If
If c.Value = "神奈川県" Then
c.Value = "14_神奈川県"
End If
If c.Value = "新潟県" Then
c.Value = "15_新潟県"
End If
If c.Value = "富山県" Then
c.Value = "16_富山県"
End If
If c.Value = "石川県" Then
c.Value = "17_石川県"
End If
If c.Value = "福井県" Then
c.Value = "18_福井県"
End If
If c.Value = "山梨県" Then
c.Value = "19_山梨県"
End If
If c.Value = "長野県" Then
c.Value = "20_長野県"
End If
If c.Value = "岐阜県" Then
c.Value = "21_岐阜県"
End If
If c.Value = "静岡県" Then
c.Value = "22_静岡県"
End If
If c.Value = "愛知県" Then
c.Value = "23_愛知県"
End If
If c.Value = "三重県" Then
c.Value = "24_三重県"
End If
If c.Value = "滋賀県" Then
c.Value = "25_滋賀県"
End If
If c.Value = "京都府" Then
c.Value = "26_京都府"
End If
If c.Value = "大阪府" Then
c.Value = "27_大阪府"
End If
If c.Value = "兵庫県" Then
c.Value = "28_兵庫県"
End If
If c.Value = "奈良県" Then
c.Value = "29_奈良県"
End If
If c.Value = "和歌山県" Then
c.Value = "30_和歌山県"
End If
If c.Value = "鳥取県" Then
c.Value = "31_鳥取県"
End If
If c.Value = "島根県" Then
c.Value = "32_島根県"
End If
If c.Value = "岡山県" Then
c.Value = "33_岡山県"
End If
If c.Value = "広島県" Then
c.Value = "34_広島県"
End If
If c.Value = "山口県" Then
c.Value = "35_山口県"
End If
If c.Value = "徳島県" Then
c.Value = "36_徳島県"
End If
If c.Value = "香川県" Then
c.Value = "37_香川県"
End If
If c.Value = "愛媛県" Then
c.Value = "38_愛媛県"
End If
If c.Value = "高知県" Then
c.Value = "39_高知県"
End If
If c.Value = "福岡県" Then
c.Value = "40_福岡県"
End If
If c.Value = "佐賀県" Then
c.Value = "41_佐賀県"
End If
If c.Value = "長崎県" Then
c.Value = "42_長崎県"
End If
If c.Value = "熊本県" Then
c.Value = "43_熊本県"
End If
If c.Value = "大分県" Then
c.Value = "44_大分県"
End If
If c.Value = "宮崎県" Then
c.Value = "45_宮崎県"
End If
If c.Value = "鹿児島県" Then
c.Value = "46_鹿児島県"
End If
If c.Value = "沖縄県" Then
c.Value = "47_沖縄県"
End If
Next c

Application.ScreenUpdating = True

End Sub

これをもっと短くすることは可能ですか？

回答No.2

neKo_quatre · ベストアンサー

Select～Caseを使うと、半分くらいになると思います。

For Each c In Selection
Select Case c.Value
　Case "北海道"
　　c.Value = "01_北海道"
　Case "青森県"
　　c.Value = "02_青森県"
～
　Case "沖縄県"
　　c.Value = "47_沖縄県"
End Select

コードが読みにくい、汎用性が多少削がれて構わない、横に長くなってＯＫなら、

"北海道＿青森県＿岩手県＿・・・沖縄県＿"

って４文字ずつ列挙している文字列から、対象のC.Valueが何文字目に見つかるかInStr関数で検索して、何番目か計算、数字を付加とか。

Dim iFound as Integer

iFound = Int((InStr("北海道＿青森県＿岩手県＿～<中略>～東京都＿神奈川県新潟県＿～<中略>～沖縄県＿", c.Value) -1 ) / 4) + 1
c.Value = Text(iFound, "00") & "_" & c.Value

お礼

ありがとうございます。
select caseを使わせていただきます。

回答No.3

imogasi

エクセルＶＢＡの質問らしいね。
シートの使わない２列の範囲に府県コード隣列に県名のテーブルを作っておく
北海道 01
青森県 02
岩手県 03
以下行略
コード
下記から実際のニーズに合わせてコードを作れば仕舞。
標準モジュールに
Sub test01()
f = "青森県"
x = Application.WorksheetFunction.VLookup(f, Range("h1:i47"), 2, False)
MsgBox x
MsgBox x & "_" & f
End Sub
と入れてやってみること。
既回答のＭＡＴＣＨ関数と似ている。
ーー
Ｆｉｎｄメッソッドでもできる。
Sub test02()
f = "青森県"
Set x = Range("h1:i47").Find(f)
MsgBox x.Offset(0, 1)
MsgBox x.Offset(0, 1) & "_" & f
End Sub
それにしても検索はコンピュターの処理の大問題です。
色々勉強するべきです。
質問の表現は稚拙で冗長。今までこういうことを考えたことがないのかな？
質問文はＶＢＡで「府県名で、府県コードを検索したい」で済むこと。
ただ量が（府県は）５０程度なんだか、１０万（郵便番号など）にもなると表を作るのも大変。データベースを作って、ＡＣＣＥＳＳＶＢＡなどで処理する分野だよ。

お礼

ありがとうございます。
勉強しています。

回答No.1

mt2015

私なら、せっかくExcelを使っているんですから、空いている列に都道府県名を順に入れておき、以下の様なコードにします。
＃例としてA1：A47に都道府県名が入っているものとします。

Sub sample()
　　Application.ScreenUpdating = False
　　For Each c In Selection
　　　　xCode = Application.Match(c.Value, Range("A1:A47"), 0)
　　　　If IsNumeric(xCode) Then
　　　　　　c.Value = Format(xCode, "00") & "_" & c.Value
　　　　End If
　　Next c
　　Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。
参考させていただきます。