みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

投稿日時 - 2017-01-06 10:00:08

QNo.9277558

困ってます

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

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


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

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

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

Dim iFound as Integer

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

投稿日時 - 2017-01-06 11:25:48

お礼

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

投稿日時 - 2017-01-06 12:08:07

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

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

投稿日時 - 2017-01-06 12:27:17

お礼

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

投稿日時 - 2017-01-06 12:48:59

ANo.1

私なら、せっかく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

投稿日時 - 2017-01-06 10:59:27

お礼

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

投稿日時 - 2017-01-06 12:07:15

あなたにオススメの質問