ハガキ印刷で、住所を2-3行に分割して印刷するため
住所の分割を行います。
正規表現パターンは
こちらを使わせていただきました
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