'----------------------------------------------------------------------
'ygpړIz
'@@XNvǵANbv{[h̃f[^Aȉ̌`̌r
'@gp\ɕϊ邽߂̃c[łB
'@@\̐iӓ_j́Aȉ̇@`CQƂB
'@@
'@@    A     B     C     
'@@
'@@sPsPA sPB sPC 
'@@
' @ DATA()z(E)(E)
'@@
'@@@\̍쐬̑ΏۃAvP[V̐͂܂񂪁AExcel
'@@Wordō쐬\̕ϊz肵Ă܂B
'@@@@AvP[VɂẮA܂ϊłȂ\܂B
'@@@@Gȕ\Ȃǂ܂ϊłȂꍇ܂B
'
'@A@eZ̎PɌrň͂񂾕\ƂȂ܂B
'@@@@ЂEЂȂ̐ݒA̎ށir̎ށj
'@@@@ݒ(ύX)͂ł܂B
'@@@@eLXgf[^́AExcelō쐬\̌r̃IuWFNg
'@@@@f[^A̕\irj̏Ԃ𔻒f邱ƂłȂ
'@@@@߁AeZ̎ꗥɌrň͂ł܂B
'@@@@
'@B@z(ƃJ}݂̂̕)͉El߁AȊO͕
'@@ƂĈAl߂ŕϊ܂B
'@@@@\ʒuݒiύXj邱Ƃ͂ł܂B
'@@@
'@C@eLXgt@Cɓ\t\̃CAEgĕ\
'@@ꍇ́AtHg̎ނύXĂB
'@@@()lrSVbNlrɕύX
'@@@@tHg̎ނɂẮA̕\̉eŁAĕ\
'@@@@܂B
'
'ygp^C~Oz
'@@e-TAXO[vʎZAe-TAXA[łASP1000RɂāAMГƎ
'@CAEg̍\ŌʒL\ǂݍނɂ́AeLXgt@C
'@ʒL\쐬Kv܂B
'
'@@Excelō쐬ʒL\eLXgt@CɕϊƁA\
'@f[^݂̂ϊAr̃IuWFNg͎܂B
'@(ϊ܂B)
'@
'@@eLXgt@CɌrgp\쐬͎̂Ԃ
'@邽߁Ac[pAʒL\̃eLXgt@C
'@̍쐬̈ꏕɂȂ΍KłB
'
'ygp@z
'@PDExcelō쐬ʒL\JAϊΏۂ̕\̃Z
'@@IăRs[(Ctrl + C)܂B
'@@  (Nbv{[h()ɁARs[\̃f[^ۑ
'@@܂B)
'
'@QDt@C_uNbNŎs܂B
'@@ iNbv{[hɃRs[ꂽ\̃f[^eLXgf[^
'@@@@ oArgpeLXg̕\쐬āA
'@@@@ Nbv{[hɃRs[(ۑ)܂B)
'@@@@mFbZ[W\̂ŁAunjv{^NbN܂B
'@@A@uAʂ\āAYʂɕ܂B
'@@B@mFbZ[W\̂ŁAunjv{^NbN܂B
'
'@RDeLXgt@CJA\t(Ctrl + V)Ŏgp܂B
' @@ (Nbv{[hAeLXgt@CɌrgp\
'   @ @ \t܂Bj
'@@@@rgp\̃CAEgĕ\ꍇ́A
'@@@@eLXgt@C̃tHg̎ނύXĂB
'@@@@()lrSVbNlrɕύX
'
'y쐬ҁz
'@sjbwvfXN
'
'y쐬z
'@2023N111
'
'yƐӎz
'@@c[̂pXNvgR[h̉ғ͎RɍsĂ
'@܂ApɔQsɂĂ̐ӔC͕˂܂̂ŁA
'@炩߂B
'
'@@܂AYc[Ɋւ邲s̂kɂ܂ẮA
'@{Iɂ󂯂ł˂܂ƂB
'----------------------------------------------------------------------

'ODϐ
dim tblTextData			'Nbv{[h(=Excelō쐬\)擾eLXgf[^
dim tblRows				'\f[^̍sz
dim tblRowColumns		'\f[^̂Ps̃Jz
dim MaxColumnCountArray	'eJ̍ő啝̔z@eJ̕肷邽߂ɕKv

dim MaxColumnCount		'SĂ̍s̒̍őJ@\̃J肷邽߂ɕKv
MaxColumnCount = 0

dim objRegExp
Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
	.Pattern = replacePattern	'̐ݒ
	.IgnoreCase = True			'SĂ̑Ώە@@False͍ŏ̈vŌ߂
	.Global = True				'啶ʂȂ@False͋ʂ)
End With

'PDf[^̏
'(1) Nbv{[heLXg̕\f[^擾
MsgBox "rgp\쐬邽߂ɁANbv{[hf[^擾܂B" & vbCrLf & "̉ʂŁAuPowerShell̉ʂ\܂B",,"MakeBoaderStringTable"
tblTextData = ReplaceText(GetClipboardText(), "[\r\n]+$", "")

'(2) zs(tblRows)̏@esɃJz(tblRowColumns)i[
tblRows = split(trim(tblTextData),vbCrLf)			's𕪊(Windows̉sR[hFvbCrLf) 
for rowIndex = 0 to UBound(tblRows)
	tblRowColumns = split(tblRows(rowIndex), vbTAB)	'Z̃f[^JzɃZbg@Excel̃Z̋؂̓eLXgɂƃ^u
	tblRows(rowIndex)=tblRowColumns
	if MaxColumnCount < UBound(tblRowColumns) then	'SĂ̍s̒̍őJvZ
		MaxColumnCount = UBound(tblRowColumns)
	end if
next

'(3) eJ̍ő咴i[z
Redim MaxColumnCountArray(MaxColumnCount)			'eJ̍ő咴i[zAőJɒ
for columnIndex=0 to UBound(MaxColumnCountArray)	' 
	MaxColumnCountArray(columnIndex)=0
next
for rowIndex = 0 to UBound(tblRows)
	tblRowColumns = tblRows(rowIndex)
	for columnIndex = 0 to UBound(tblRowColumns)
		colLen=ColLenByteCnt(tblRowColumns(columnIndex))	'J̃oCg
		colLen=colLen+(colLen Mod 2)						'r̊("")Sp̂߁AoCg͋œꂳ
		'MsgBox("tblRowColumns(" & columnIndex & ")colLenF" tblRowColumns(columnIndex) & "=" & colLen)	DebugCode
		if MaxColumnCountArray(columnIndex) < colLen then
			MaxColumnCountArray(columnIndex) = colLen		'ԃf[^s̃J̃oCgvZ
		end if
	next
next

'QDr̕\̍쐬
'(1) ̍쐬 ()

outStr = ""															'[
for columnIndex = 0 to UBound(MaxColumnCountArray)
	outStr = outStr & String(MaxColumnCountArray(columnIndex)/2, "")	'
	if columnIndex < UBound(MaxColumnCountArray) then
		outStr = outStr & ""											'J̋؂
	else
		outStr=outStr & ""											'E[
	end if
next

'(2) ȊO ('
'@@@@@@@ DATA()z(E)(E)
'@@@@@@@ )

for rowIndex = 0 to UBound(tblRows)
'@@@@f[^(1s)̕ϊ	(DATA()z(E)(E))
	tblRowColumns = tblRows(rowIndex)
	outStr = outStr & vbCrLf										'̍s
	for columnIndex =0 to UBound(tblRowColumns)						'f[^̕ϊ
		outStr = outStr & String(1, "")							'f[^s̃J̋؂
		objRegExp.Pattern = "^[0-9,]+$"								'ƃJ}̂
		if objRegExp.Test(tblRowColumns(columnIndex)) =true then	'ƃJ}݂̂͐zƔfĉElAȊO͕ƂĔfčl (pXy[XŃpfBOČŒ蒷ɂ)
			outStr = outStr & String(MaxColumnCountArray(columnIndex) - ColLenByteCnt(tblRowColumns(columnIndex)), " ")& tblRowColumns(columnIndex)
		else
			outStr = outStr & tblRowColumns(columnIndex) & String(MaxColumnCountArray(columnIndex)-ColLenByteCnt(tblRowColumns(columnIndex)), " ")
		end if
			'MsgBox("[Alert]z肳ĂȂf[^F" & tblRowColumns(columnIndex))@AlertpDebugCode
	next
	outStr=outStr & String(1, "")	'E[

'@@A@s̉
'	Zbgȑ
	if rowIndex < UBound(tblRows) then	's̋؂()
		LT = ""
		MD = ""
		RT = ""
	else								'	@ ()
		LT = ""
		MD = ""
		RT = ""
	end if

'	r̍쐬
		outStr = outStr & vbCrLf												's
		outStr = outStr & String(1, LT)
		for columnIndex = 0 to UBound(tblRowColumns) 
			outStr = outStr & String(MaxColumnCountArray(columnIndex)/2, "")	'
			'MsgBox(MaxColumnCountArray(columnIndex))	'DebugCode
			if columnIndex < UBound(tblRowColumns) then
				outStr = outStr & String(1, MD)									'J̋؂
			else
			end if
				'MsgBox("[Alert]z肳ĂȂf[^F" & MaxColumnCountArray(columnIndex))@AlertpDebugCode
		next
		outStr=outStr & String(1, RT)											'E[
next

SetClipboardText(outStr)
MsgBox "Nbv{[h̃f[^r̕\()ɕϊ܂B" & vbCrLf & "eLXgt@CJāAuCtrl + vvœ\tĂB" & vbCrLf & "eZ̎PɌrň͂񂾕\ƂȂ܂B" & vbCrLf & "@\̃CAEgCKvȏꍇ́A萔ł蓮ŒĂB",,"MakeBoaderStringTable"

Set objRegExp = Nothing

'---------------------------------------------------
'@SetClipboardText@Nbv{[hփRs[
'@1Ftext	Rs[Ώۂ̕
'---------------------------------------------------
Function SetClipboardText(text)
	Set WshShell = CreateObject("WScript.Shell")
	WshShell.Exec("clip").StdIn.Write text
	Set WshShell = Nothing
End Function

'---------------------------------------------------
'@GetClipboardText@Nbv{[heLXg擾
'
'IE11VBScriptԂŖꂽ߁A
'@PowerShelloRŃNbv{[h̃f[^擾B
'@(uPowerShell̉ʂ\B)
'---------------------------------------------------
Function GetClipboardText()
	Set exec = CreateObject("WScript.Shell").Exec("powershell.exe -sta  -Command Add-Type -Assembly System.Windows.Forms; [System.Windows.Forms.Clipboard]::GetText()")
	exec.StdIn.Close
	GetClipboardText = exec.StdOut.ReadAll
	Set exec = Nothing
End Function

'yYz(ȑÕR[h)IE11VBScriptԂŖꂽ̂ŁAHTMLIuWFNgł̓Nbv{[hɃANZXłȂ
'Function GetClipboardText()
'	Dim objHTML
'	Set objHTML = CreateObject("htmlfile")
'
'	GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
'	Set objHTML = Nothing
'End Function

'---------------------------------------------------
'@ReplaceText	K\u
'@1FtargetText		uΏۂ̕
'@2FreplacePattern	
'@3FafterPattern	u̕
'---------------------------------------------------
Function ReplaceText(targetText, replacePattern, afterPattern)
    Dim objRegExp
    Set objRegExp = CreateObject("VBScript.RegExp")

    '{̐ݒ
    With objRegExp
        .Pattern = replacePattern	'̐ݒ
        .IgnoreCase = True			'SĂ̑Ώە@@False͍ŏ̈vŌ߂
        .Global = True				'啶ʂȂ@False͋ʂ
    End With

    'us
    ReplaceText = objRegExp.Replace(targetText ,afterPattern)
    Set objRegExp = Nothing
End Function

'---------------------------------------------------
'ColLenByteCnt@eJ̃oCg擾
'@1Fstr		mFΏۂ̕
'@Sp+pJi1oCgȊO	[^\x01-\x7]
'@pJi(1oCgȊO)		[-]
'---------------------------------------------------
Function ColLenByteCnt(str)
	hankakuStr = ReplaceText(str,"[^\x01-\x7E-]+","")	'p@Sp폜c
	zenkakuStr = ReplaceText(str,"[\x01-\x7E-]+","")	'Sp@p폜c
	ColLenByteCnt = Len(zenkakuStr)*2+Len(hankakuStr)	'oCg
End Function