【VBA】住所録の東西南北(Adress Editor)

 今回も忙しいからちょっと手抜き … あ、いえ、KOBATO’s BOOK に組込まれている Adress Editor というソフトの部品マクロを紹介します! たとえば、次のような住所録がテーブル形式で入っているとします(下の住所はソフトで作成された架空のものです)。

住所一覧
大阪府堺市P区小阪合町 6-47-2
大阪府大阪市旭区中の島町 6-23-6
大阪府高石市深井沢町 3-11
大阪府岸和田市渚P町 1-7-5
大阪府大阪市都島区P野Q 4-58
大阪府大阪市P区畑 32
大阪府大阪市P住吉区打上元町 6-26-8
大阪府大阪市阿倍野区春木旭町 5-3
大阪府大阪市港区上之宮町 60
大阪府堺市P区桜ケ丘Q町R 7-40-9

 所々に P, Q, R というアルファベットが組込まれていますね。ここに 東西南北 から無作為に1つずつ選んで当てはめていくのが、NEWS() マクロです。Adress Editor で最後の仕上げをしてくれるマクロなのです。

【VBA】住所録用 NEWS マクロ

 このマクロを試す場合は、上の一覧をコピーして貼りつけて、[ホーム] ⇒ [テーブルとして書式設定] でデータをテーブルに変換し、[テーブルツール] でテーブル名を「住所」としてください。

Option Base 1

Sub NEWS()

  Dim i As Integer, j As Integer
  Dim ct As Integer, rd As Integer
  Dim x As String
  Dim mydata(4) As String
  Dim myrange As Range

  Randomize

  ‘リストの行数を数えてctに格納
  ct = ActiveSheet.ListObjects(“住所”).ListRows.Count

  ‘見出し以外の部分をmyrangeに格納
  Set myrange = ActiveSheet.ListObjects(“住所”).DataBodyRange

  ‘配列に東西南北を格納
  mydata(1) = “東”
  mydata(2) = “西”
  mydata(3) = “南”
  mydata(4) = “北”

  ‘リストの全ての行について処理
  For j = 1 To ct

    ‘配列をシャッフル
    For i = 1 To 4
      rd = Int(4 * RND + 1)
      x = mydata(i)
      mydata(i) = mydata(rd)
      mydata(rd) = x
    Next i

    ‘アルファベットを東西南北に置き換えます
    myrange.Cells(j, 1).Replace what:=”P”, replacement:=mydata(1)
    myrange.Cells(j, 1).Replace what:=”Q”, replacement:=mydata(2)
    myrange.Cells(j, 1).Replace what:=”R”, replacement:=mydata(3)
    myrange.Cells(j, 1).Replace what:=”S”, replacement:=mydata(4)

  Next j

End Sub

 NEWS() マクロを実行すると、アルファベットに方角が書き込まれて、たとえば最初の行にある

大阪府堺市P区小阪合町 6-47-2

というデータが

大阪府堺市西区小阪合町 6-47-2

というように変わるはずです。えーとね、今ちょっとこばとは、周囲で「ごたごた」があって、なかなかこのサイトを更新できないですけど、全部解決したら、もう毎日のようにがんがん新しい記事を載せる予定です。それじゃまたね~♪

Excel VBA
Excel VBA 表計算とプログラミング学習サイト

コメント

タイトルとURLをコピーしました