Free版　Office calc Basic 正規表現による　住所分割について

ハガキ印刷で、住所を２－３行に分割して印刷するため
住所の分割を行います。

正規表現パターンは
こちらを使わせていただきました
http://qiita.com/zakuroishikuro/items/066421bce820e3c73ce9

郵便番号データ 2017/04/21 時点の ken_allデータ
124114件のデータでチェックしてみましたが、全件エラーなしで完璧に分割です。
すばらしい！ありがとうございます。

以下　チェック用 basicです
シートに住所のみ貼り付けて変換データをセルに書き込みましたが
4分ほどで終了しました、そんなに遅くはないと思います。

|都道府県|市町村|番地|住所結合||結果：都道府県|結果：市町村|
|北海道|札幌市中央区|三条|北海道札幌市中央区三条||北海道|札幌市中央区|

''//-----------------------------------------------------------------チェック関数
sub adrsdevideCheck()
	Dim sh as Object
	Dim rowi as double
	Dim regStr as String
	dim arrMatch()
	Dim startTime as String
	Dim EndTime as String
	
	startTime=Now()
	
	
	regStr = "(...??[都道府県])((?:旭川|伊達|石狩|盛岡|奥州|田村|南相馬|那須塩原|東村山|武蔵村山|羽村|十日町|上越|富山|野々市|大町|蒲郡|四日市|姫路|大和郡山|廿日市|下松|岩国|田川|大村)市|.+?郡(?:玉村|大町|.+?)[町村]|.+?市.+?区|.+?[市区町村])(.+)"

	sh=ThisComponent.Sheets.getByName("Sheet5")

	rowi=0	
	do while sh.getCellByPosition(2,rowi).String<>""
			matchexp( sh.getCellByPosition(3,rowi).String,regStr,arrMatch)
			sh.getCellByPosition(5,rowi).String=arrMatch(2)
			sh.getCellByPosition(6,rowi).String=arrMatch(3)
			rowi = rowi+1		
	loop
	
	MsgBox(startTime & "-" & Now())

end sub

''//--------------------------------------------------------------------------正規表現match
Function matchexp(src as string,searchstr as string,arrMatch  ) as Integer

	Dim oTextSearch as Object
	Dim oOption as Object
	Dim searchStart as Integer
	dim i as integer
	ReDim Preserve  arrMatch(0)
	
	arrMatch(0)=src
	oTextSearch = CreateUnoService("com.sun.star.util.TextSearch")
	oOption = CreateUnoStruct("com.sun.star.util.SearchOptions")

	oOption.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
	oOption.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED
	oOption.searchString = searchstr

	oTextSearch.setOptions(oOption)

	searchStart=0
	do while  searchStart < Len(src)
		oResult = oTextSearch.searchForward(src,searchStart,Len(src))
  		If oResult.subRegExpressions = 1 Then
  			searchStart = oResult.endOffset(0) 		
			
			ReDim Preserve  arrMatch(UBound( arrMatch )+1)
			
			arrMatch(UBound(arrMatch))=mid(src,oResult.startOffset(0) +1,oResult.EndOffset(0) -oResult.startOffset(0))
		elseif oResult.subRegExpressions > 1 Then
			for i=0 to ubound(oResult.startOffset)
				ReDim Preserve  arrMatch(UBound( arrMatch )+1)
				arrMatch(UBound(arrMatch))=mid(src,oResult.startOffset(i) +1,oResult.EndOffset(i) -oResult.startOffset(i))
			
			next		
			searchStart=Len(src)
    	else
			searchStart=Len(src)
  		End If
	
	loop

	matchexp=ubound(arrMatch)


end function

''//-----------------------------------------------------------------チェック関数

sub adrsdevideCheck()

Dim sh as Object

Dim rowi as double

Dim regStr as String

dim arrMatch()

Dim startTime as String

Dim EndTime as String

startTime=Now()

regStr = "(...??[都道府県])((?:旭川|伊達|石狩|盛岡|奥州|田村|南相馬|那須塩原|東村山|武蔵村山|羽村|十日町|上越|富山|野々市|大町|蒲郡|四日市|姫路|大和郡山|廿日市|下松|岩国|田川|大村)市|.+?郡(?:玉村|大町|.+?)[町村]|.+?市.+?区|.+?[市区町村])(.+)"

sh=ThisComponent.Sheets.getByName("Sheet5")

rowi=0

do while sh.getCellByPosition(2,rowi).String<>""

matchexp( sh.getCellByPosition(3,rowi).String,regStr,arrMatch)

sh.getCellByPosition(5,rowi).String=arrMatch(2)

sh.getCellByPosition(6,rowi).String=arrMatch(3)

rowi = rowi+1

loop

MsgBox(startTime & "-" & Now())

end sub

''//--------------------------------------------------------------------------正規表現match

Function matchexp(src as string,searchstr as string,arrMatch ) as Integer

Dim oTextSearch as Object

Dim oOption as Object

Dim searchStart as Integer

dim i as integer

ReDim Preserve arrMatch(0)

arrMatch(0)=src

oTextSearch = CreateUnoService("com.sun.star.util.TextSearch")

oOption = CreateUnoStruct("com.sun.star.util.SearchOptions")

oOption.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP

oOption.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED

oOption.searchString = searchstr

oTextSearch.setOptions(oOption)

searchStart=0

do while searchStart < Len(src)

oResult = oTextSearch.searchForward(src,searchStart,Len(src))

If oResult.subRegExpressions = 1 Then

searchStart = oResult.endOffset(0)

ReDim Preserve arrMatch(UBound( arrMatch )+1)

arrMatch(UBound(arrMatch))=mid(src,oResult.startOffset(0) +1,oResult.EndOffset(0) -oResult.startOffset(0))

elseif oResult.subRegExpressions > 1 Then

for i=0 to ubound(oResult.startOffset)

ReDim Preserve arrMatch(UBound( arrMatch )+1)

arrMatch(UBound(arrMatch))=mid(src,oResult.startOffset(i) +1,oResult.EndOffset(i) -oResult.startOffset(i))

searchStart=Len(src)

else

searchStart=Len(src)

End If

loop

matchexp=ubound(arrMatch)

end function

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル