地域に根差した仕事のSEO対策として住所一覧をhtml化するツールを作ってみた

さいたま市浦和区町名一覧表示サンプル

今回は手っ取り早く、ネットで拾える情報をコピペして変換できるプログラムをVBAで作りました。
ア行、などの表示への変更と、フリガナのレイアウトを調整しています。

初めに

O2Oの一環として地域の商売を検索結果で表示しようとする試みはいくつもあります。
最近ではGoogleは検索場所の位置情報をもとに、地域の名前を入れない場合は近隣の情報を表示するようになっているようです。
弊社では品質の高さに重点を置いたアンテナ工事がもともとメインの業務内容ですが、「アンテナ工事」とGoogleで検索すると、近隣のアンテナ工事会社などが表示されると思います。
例えば「さいたま市浦和区のアンテナ工事のご依頼は」などと言ったページが上位表示されたりします。

こういったページの特徴として、さいたま市浦和区の町名一覧なども併記している場合が多いです。
昔こういった住所の羅列が流行り、その後見栄えが悪いために隠しテキストにされ、Googleがそういったページの評価を下げてしばらくは下火になっていた、などの歴史がありますが最近またこういったページが上位に上がってきているようですね。

そこで、住所一覧を手っ取り早くページに取り入れたいけど少し見栄えは調整したい、といった理由で作成したものです。

住所のリストをhtmlに変換
一番左が元のテキスト、右はそれぞれ変換したテキストです。

使い方

一番左のテキストエリアにネット上の住所一覧ページのテキストをコピーして貼り付けます。
変換ボタンを押すと、それぞれのテキストエリアに変換後のhtmlが表示されるため、ブログなどにそのままコピペします。

行っていること

これは某マップサイトのデータを拝借したものです。
ただしそのサイトではrubyタグを使用せずに見栄えを調整していたため、コピーすると町名は「漢字表記」「ふりがな」の順番になっています。
これをrubyタグで表記するために順番を入れ替えます。
また、フリガナの文字数が多い場合はフリガナ同士が重なってしまうため、長さによってmarginを調整するためのclass属性を挿入しています。
漢字のletter-spacingを調整するという方法もありそうですので、そのうち対応するかもしれません。ただあまりにも漢字とフリガナの文字数のバランスが悪いと、読みづらくなる可能性もあるため難しいところです。

フリガナのひらがなはカタカナに変換しています。
ア行、カ行などの見出しを<h4>タグで作成しています。
またページ内リンクに対応するためにそれぞれidを振っています。
ruby,rtのタグを挿入しています。ただし、このままの表示では行間の乱れなどもあり見苦しいので、実際の表記のためにdata-rubyという属性値を設定しそちらを表示するようにしています。

わかりやすいようにした改行入りのタイプと、容量を抑えるための改行無しの出力を行っています。

実際の表示

実際には以下のような表示で使っています。
さいたま市浦和区のアンテナ工事について

VBAコード

VBAでuserform1に以下のテキストエリアを作成します。
OriginalText
ConvertedText
ConvertedText2
ConvertedText3
ConvertedText4
それぞれMultiLine Trueにしておきます。

実行ボタンはConvertButtonとしています。

Private Sub ConvertButton_Click()

Dim oriTxt As String, oriTxt2 As String, conTxt As String, processingTxt As String, h4Kana As String
Dim pickTxt As String, pickTxt3 As String, kanji As String, furigana As String
Dim classTxt As String
Dim crPos As Integer, exRuby As Integer, strLen As Integer

ConvertedText.Text = “”
ConvertedText2.Text = “”
ConvertedText3.Text = “”
ConvertedText4.Text = “”
ConvertedText5.Text = “”
ConvertedText6.Text = “”

oriTxt = OriginalText.Text
oriTxt2 = oriTxt
conTxt = ConvertedText.Text
‘文字列の空白をなくす

oriTxt = Replace(Replace(oriTxt, ” “, “”), “ ”, “”)
If Right(oriTxt, 2) <> vbCrLf Then oriTxt = oriTxt & vbCrLf

‘マピオンの町名は(「見出し」 (「ふりがな」「町名」)loop)loop
‘見出しの次は必ずふりがな、ふりがなの次は必ず町名
‘最初は必ず見出し

exRuby = 2 ‘前のデータの状態を表す
‘0…見出し
‘1…ふりがな
‘2…町名

Do
crPos = InStr(oriTxt, vbCrLf)
pickTxt = Left(oriTxt, (crPos – 1))
oriTxt = Right(oriTxt, Len(oriTxt) – (crPos + 1))
classTxt = “”

OriginalText.Text = oriTxt

If Left(pickTxt, 1) Like “[あ-ん]” And exRuby <> 1 Then ‘取得した文字がひらがなで、前のデータがフリガナではない

pickTxt = StrConv(pickTxt, vbKatakana) ‘ひらがなをカタカナに変換

If Len(pickTxt) = 1 Then ‘取得した文字が1文字(見出し)の場合

Select Case pickTxt
Case “ア”
h4Kana = “a”
Case “カ”, “ガ”
h4Kana = “ka”
Case “サ”, “ザ”
h4Kana = “sa”
Case “タ”, “ダ”
h4Kana = “ta”
Case “ナ”
h4Kana = “na”
Case “ハ”, “バ”, “パ”
h4Kana = “ha”
Case “マ”
h4Kana = “ma”
Case “ヤ”
h4Kana = “ya”
Case “ラ”
h4Kana = “ra”
Case “ワ”
h4Kana = “wa”
End Select

pickTxt = “<h4 id=” & Chr(34) & “kana-” & h4Kana & Chr(34) & ” name=” & Chr(34) & “kana-” & h4Kana & Chr(34) & “>” & _
pickTxt & “行</h4>” & vbCrLf & “<span class=” & Chr(34) & “clearfix” & Chr(34) & “>” & vbCrLf

If ConvertedText.Text <> “” Then pickTxt = “</span>” & vbCrLf & vbCrLf & pickTxt ‘最初以外</span>を加える

pickTxt3 = pickTxt ‘data-rubyを入力する場合のテキスト(ここでは共通)

exRuby = 0 ‘見出しを入力

Else ‘取得した文字がフリガナの場合
furigana = pickTxt
exRuby = 1
End If

Else ‘取得した文字がひらがな以外、もしくは前のデータがふりがなではない場合、つまり町名の場合
kanji = pickTxt

Select Case (Len(furigana) * 0.6) – Len(kanji)
Case Is < 1
Case Is < 1.5
classTxt = “class=” & Chr(34) & “ruby2” & Chr(34)
Case Is < 2.5
classTxt = “class=” & Chr(34) & “ruby3” & Chr(34)
Case Is < 3.5
classTxt = “class=” & Chr(34) & “ruby4” & Chr(34)
Case Is < 4.5
classTxt = “class=” & Chr(34) & “ruby5” & Chr(34)
Case Is < 5.5
classTxt = “class=” & Chr(34) & “ruby6″ & Chr(34)
End Select

pickTxt = ” <ruby data-ruby=” & Chr(34) & furigana & Chr(34) & “>” & kanji & “<rt>” & furigana & “</rt></ruby>” & vbCrLf
pickTxt3 = ” <ruby data-ruby=” & Chr(34) & furigana & Chr(34) & classTxt & “>” & kanji & “<rt>” & furigana & “</rt></ruby>” & vbCrLf ‘data-ruby、を入力
exRuby = 2 ‘町名を入力したフラグ

End If

If exRuby <> 1 Then
ConvertedText.Text = ConvertedText.Text & pickTxt
ConvertedText3.Text = ConvertedText3.Text & pickTxt3
End If

Loop While Len(oriTxt) > 1

ConvertedText.Text = ConvertedText.Text & “</span>”
ConvertedText2.Text = Replace(Replace(ConvertedText.Text, vbCrLf, “”), ” “, “”)
ConvertedText4.Text = Replace(Replace(ConvertedText3.Text, vbCrLf, “”), ” “, “”)
OriginalText.Text = oriTxt2
End Sub


CSS

ポイントはdata-rubyの中身を表示してrtの中身を表示しないところですが、それ以外にdata-rubyの

		word-break: keep-all;
		margin-right:-3rem;

もポイントです。

ruby{
	font-size:1.2rem!important;
	text-decoration:none;
	box-shadow: none;
	border: none;
	box-sizing: border-box;
	display: inline-block !important;
	float: left;
	line-height: 3.5rem;
	padding: 0;
	position: relative;
	margin: 0 1rem 0 0;
	text-decoration: none;
	word-break: keep-all;
	-webkit-transition: color 0.2s;
}
ruby.ruby2{margin-right:2rem;}
ruby.ruby3{margin-right:3rem;}
ruby.ruby4{margin-right:4rem;}
ruby.ruby5{margin-right:5rem;}
ruby.ruby6{margin-right:6rem;}

[data-ruby] {
    position: relative;
}
[data-ruby]::before {
		content: attr(data-ruby);
		position: absolute;
		top: -1.2rem;
		left: 0;
		right: 0;
		margin: auto;
		font-size: 0.5em;
		word-break: keep-all;
		margin-right:-3rem;
}
rt {
    display: none;
}
.clearfix::after {
  content: "";
  display: block;
  clear: both;
}

地域に根差した仕事のSEO対策として住所一覧をhtml化するツールを作ってみた

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

トップへ戻る

Pin It on Pinterest