Excel VBAでJavaScript関数(search,match,replace)を使って正規表現検索・置換
//＜sample01.js＞
function RegRepl(a){
var c1 = a.search(/AB+C/);
var c2 = a.match(/AB+C/);
var c3 = a.replace(/(AB+C)/,"($1)");
return c3 + "\t" + c1 + "\t" + c2;
}
var myStr = "置換前\n";
myStr = myStr + "CFEFCGDFAEFDAFADFABG" + "\n";
myStr = myStr + "CFEFCGDFABFDAFADFABG" + "\n";
myStr = myStr + "CFEFCGDFABCDAFADFABG" + "\n";
myStr = myStr + "CFEFCGDABBCDAFADFABG" + "\n";
myStr = myStr + "CFEFCGABBBCDAFADFABG" + "\n";
myStr = myStr + "CFEFCABBBBCDAFADFABG" + "\n";
myStr = myStr + "置換後\n";
myStr = myStr + RegRepl("CFEFCGDFAEFDAFADFABG") + "\n";
myStr = myStr + RegRepl("CFEFCGDFABFDAFADFABG") + "\n";
myStr = myStr + RegRepl("CFEFCGDFABCDAFADFABG") + "\n";
myStr = myStr + RegRepl("CFEFCGDABBCDAFADFABG") + "\n";
myStr = myStr + RegRepl("CFEFCGABBBCDAFADFABG") + "\n";
myStr = myStr + RegRepl("CFEFCABBBBCDAFADFABG") + "\n";
WScript.Echo(myStr);
こんな感じ。これをExcel上で行う。
EXCEL VBAにて。
＜20190110追記STA＞
MS-Office 64bitでは、
CreateObject("ScriptControl")ができないようです。
MS-Office 32bitなら、動くようです。
＜20190110追記END＞
Sub Make_data()
'置換前データ作成用
Dim moji1 As Variant
moji = Array("A", "B", "C", "D", "E", "F", "G")
Dim data01(19) As String
Dim WSFunc As WorksheetFunction
Set WSFunc = Application.WorksheetFunction
Dim i As Integer
Dim j As Byte
For i = 2 To 10001
For j = 0 To 19
data01(j) = moji(WSFunc.RandBetween(0, 6))
Next
Worksheets("Sheet2").Range("A" & i).Value = Join(data01, "")
Next
MsgBox "処理終了"
End Sub
Sub JScript_Regx2()
Dim nJS
Dim oJS
Dim myRange
Set nJS = CreateObject("ScriptControl")
nJS.Language = "JScript"
nJS.AddCode "function RegRepl(a){ " & _
" var c1 = a.search(/AB+C/); " & _
" var c2 = a.match(/AB+C/); " & _
" var c3 = a.replace(/(AB+C)/,""（$1）""); " & _
" return c1 + ""\t"" + c2 + ""\t"" + c3; " & _
"} "
Set oJS = nJS.CodeObject
Dim return_data
For i = 2 To 10001
return_data = Split(oJS.RegRepl(Worksheets("Sheet2").Range("A" & i).Value), vbTab)
Worksheets("Sheet2").Range("D" & i).Value = return_data(0)
Worksheets("Sheet2").Range("E" & i).Value = return_data(1)
Worksheets("Sheet2").Range("F" & i).Value = return_data(2)
Next
MsgBox "処理終了"
End Sub
SEのためのExcelツール 様 のところに
http://srcedit.pekori.jp/
「正規表現検索
Excel用正規表現検索ダイアログアドイン」
http://srcedit.pekori.jp/tool/excelre.html
というスグレものツールがあるのですが、今の現場では、持ち込めないため作成してみた。
RegExpオブジェクト
"Office TANAKA"様 正規表現によるマッチング
http://officetanaka.net/excel/vba/tips/tips38.htm
Set oRE = CreateObject("VBScript.RegExp")
でもいいのですが。できるかもと思い、やってみただけ。
＜2018111追記STA＞VBScript.RegExpの場合
Sub VBScript_Regx2()
Dim oRE
Dim myRep
Dim myRepStr
Dim newStr
Set oRE = CreateObject("VBScript.RegExp")
oRE.Pattern = "(AB+C)"
myRepStr = "($1)"
oRE.IgnoreCase = True
oRE.Global = True
Dim WS3
Set WS3 = Sheets("Sheet3")
Dim myRange
Dim resMatch
Application.ScreenUpdating = False
For i = 2 To 10001
myRange = WS3.Range("A" & i).Value
Set resMatch = oRE.Execute(myRange)
If resMatch.Count > 0 Then
WS3.Range("D" & i).Value = resMatch.Item(0).FirstIndex
WS3.Range("E" & i).Value = resMatch.Item(0).Value
Else
WS3.Range("D" & i).Value = ""
WS3.Range("E" & i).Value = ""
End If
WS3.Range("G" & i).Value = oRE.Replace(myRange, myRepStr)
Next
Application.ScreenUpdating = True
MsgBox "処理終了"
End Sub
＜2018111追記END＞
＜20181228追記STA＞
Sub JScript_sort()
Dim nJS
Dim oJS
Dim myRange
Set nJS = CreateObject("ScriptControl")
nJS.Language = "JScript"
nJS.AddCode "function JSsort(data){ " & _
" var mykey01 = data.split(""\t"") ;" & _
" mykey01.sort(func_sort) ;" & _
" return mykey01.join(""\t"") ;" & _
"} " & _
"function func_sort(a,b){ " & _
" if(a * 1.0 > b * 1.0) return 1;" & _
" else return -1;" & _
"} "
Set oJS = nJS.CodeObject
Dim mydata
Dim return_data
mydata = Array(555, 444, 666, 222, 111, 333, 888, 777, 999, 5, 4, 6, 2, 1, 3, 8, 7, 9, 55, 44, 66, 22, 11, 33, 88, 77, 99)
return_data = oJS.JSsort(Join(mydata, vbTab))
MsgBox Replace(return_data, vbTab, vbLf)
End Sub
Sub JScript_sort2()
Dim nJS
Dim oJS
Dim myRange
Set nJS = CreateObject("ScriptControl")
nJS.Language = "JScript"
nJS.AddCode "function JSsort(data){ " & _
" var mykey01 = data.split(""\t"") ;" & _
" mykey01.sort(func_sort) ;" & _
" return mykey01.join(""\t"") ;" & _
"} " & _
"function func_sort(a,b){ " & _
" if(a + """" > b + """") return 1;" & _
" else return -1;" & _
"} "
Set oJS = nJS.CodeObject
Dim mydata
Dim return_data
mydata = Array(555, 444, 666, 222, 111, 333, 888, 777, 999, 5, 4, 6, 2, 1, 3, 8, 7, 9, 55, 44, 66, 22, 11, 33, 88, 77, 99)
return_data = oJS.JSsort(Join(mydata, vbTab))
MsgBox Replace(return_data, vbTab, vbLf)
End Sub
＜20181228追記END＞
＜20190131追記STA＞
64bit環境で VBA、VBScriptからJScript(javascript)の関数を使用する。
”書いて忘れる”様
vba/vbscript:64bit環境でJSONをパース
http://bougyuusonnin.seesaa.net/article/446183415.html
”@nukie_53”様
Qiita VBAからJScriptのfunctionオブジェクトを使用する（64bit対応）
https://qiita.com/nukie_53/items/297e524bcc8e43f9b5d1
”Beginner'sMemo初心者備忘録”様
64ビット環境でのScriptControlの代わり
http://www.ka-net.org/office/of32.html
ありがとうございました。使わせていただきます。
上記3つの記事の使用方法を、学習後、
吉岡さんのソースに当たってみた
googleで”吉岡照雄”で検索するとでてきます。
作者: 吉岡 照雄 - Vector
https://www.vector.co.jp/vpack/browse/person/an010222.html
●history.VBS
「履歴」をHTMLファイルにする、「履歴」のサブフォルダを開くVBScript
＜中身＞
History.TXT
History.VBS
History98.VBS
TechNote.TXT
最近使ったファイルメニュー.VBS
履歴／今日／マイ コンピュータ.VBS
”History98.VBS” の中に CreateObject("htmlfile")の恐ろしいサンプルがあった。
2006-07-02に既に検討済みとは、本当に驚愕した。
＜見所＞
(1) VBScript中でJavaScriptの new Array()を実現
(2) VBScript中で(1)のArray の push 、shiftを行う
(3) VBScriptから JScript(Javascript)のユーザ定義関数を呼び出し、
さらにそこからVBScriptのユーザ定義関数を使用させる
＜20190131追記END＞
＜20190210追記STA＞
＜自己記事＞
64bit環境で VBA、VBScriptからJScript(javascript)の関数を使用する。
https://blog.goo.ne.jp/tkhs1732/e/a565bd5b289b1de72208e30449fb0268
＜20190210追記END＞
