今回も忙しいからちょっと手抜き ...... あ、いえ、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 というアルファベットが組込まれていますね。
ここに「東西南北」から無作為に１つずつ選んで当てはめていくのが、方角組込というマクロです。Adress Editor で最後の仕上げをしてくれるマクロなのです。
方角組込マクロ
このマクロを試す場合は、上の一覧をコピーして貼りつけて、[ホーム] ⇒ [テーブルとして書式設定] でデータをテーブルに変換し、[テーブルツール] でテーブル名を「住所」としてください。
Sub 方角組込()
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
マクロを実行すると、アルファベットに方角が書き込まれて、たとえば最初の行にある
というデータが
というように変わるはずです。えーとね、今ちょっとこばとは、周囲で「ごたごた」があって、なかなかこのサイトを更新できないですけど、全部解決したら、もう毎日のようにがんがん新しい記事を載せる予定ですよー♪ それじゃまたねー♪
