文字列の配列処理

  動的配列処理



テキストファイルからのロードを使用しないのであれば、Sep は vbCrLf である必要はありません
( Chr( 0 ) で良いです )

ソート用の レコードセットオブジェクトは、関数内で Dim しているので、関数が終了すれば解放されます

※ 動的配列を Dim aData() で定義しないで下さい

配列要素は一つ一つ削除しなくても、対象要素に削除文字をいれておいて

strValue = Join( aTarget, Sep )
strValue = Replace( strValue, DelChar & Sep, "" )
strValue = Replace( strValue, Sep & DelChar, "" )
aTarget = Split( strValue, Sep )

すれば良いです

  
' **********************************************
' 定義
' **********************************************
Set Fso = CreateObject( "Scripting.FileSystemObject" )
DelChar = Chr(0)		' 配列要素を削除するのに使用する文字
Sep = vbCrLf		' 配列データに含まれない文字列を使用
SORT_STRING_MAX = 1024	' ソート用

' **********************************************
' 処理
' **********************************************
' 配列作成( または、クリア )
' aData が動的配列として定義されていれば、Redim aData(-1) でも同等
aData = Array()

' 配列追加
Call ArrayAdd( aData, "0001" )
Call ArrayAdd( aData, "0009" )
Call ArrayAdd( aData, "9999" )
Call ArrayAdd( aData, "0005" )
Call ArrayAdd( aData, "0002" )

Call ArrayDelete( aData, 2 )
Call ArrayInsert( aData, -1, "開始位置" )
Call ArrayInsert( aData, 3, "0005の後" )

' 配列列挙
For I = 0 to Ubound( aData )
	WScript.Echo ( aData(I) )
Next

WScript.Echo _
" ----------------------------------------------"

' テキストファイル(CrLf)より読み込み
Call ArrayLoad( aData, "ArrayData.txt" )
' 配列列挙
For I = 0 to Ubound( aData )
	WScript.Echo ( aData(I) )
Next

WScript.Echo _
" ----------------------------------------------"

' ソート( 第2引数を True にすると、逆ソート )
' ソート処理のみ、配列の実体が入れ替わります
aData = ArraySort( aData, False )
' 配列列挙
For I = 0 to Ubound( aData )
	WScript.Echo ( aData(I) )
Next

' **********************************************
' 配列追加
' **********************************************
Function ArrayAdd( aTarget, strValue )

	ReDim Preserve aTarget(Ubound(aTarget)+1)
	aTarget( Ubound(aTarget) ) = strValue

End Function

' **********************************************
' 配列挿入
' **********************************************
Function ArrayInsert( aTarget, nIndex, strValue )

	Dim strWork

	if nIndex = -1 then
		aTarget( 0 ) = strValue & Sep & aTarget( 0 )
	else
		aTarget( nIndex ) = _
			aTarget( nIndex ) & Sep & strValue
	end if
	strWork = Join( aTarget, Sep )
	aTarget = Split( strWork, Sep )

End Function

' **********************************************
' 配列要素削除
' **********************************************
Function ArrayDelete( aTarget, nIndex )

	Dim strValue

	aTarget( nIndex ) = DelChar
	strValue = Join( aTarget, Sep )
	strValue = Replace( strValue, DelChar & Sep, "" )
	strValue = Replace( strValue, Sep & DelChar, "" )
	aTarget = Split( strValue, Sep )

End Function

' **********************************************
' テキストフイルより読み込み
' **********************************************
Function ArrayLoad( aTarget, strPath )

	Dim objHandle,strWork

	Set objHandle = Fso.OpenTextFile( strPath, 1 )
	aTarget = Split( objHandle.ReadAll, Sep )
	objHandle.Close
	if aTarget( Ubound( aTarget ) ) = "" then
		Call ArrayDelete( aTarget, Ubound( aTarget ) )
	end if

End Function

' **********************************************
' ソート
' **********************************************
Function ArraySort( aTarget, bDesc )

	Dim Rs

	Set Rs = CreateObject("ADODB.Recordset")

	Rs.Fields.Append "ソート", 130, SORT_STRING_MAX
	Rs.Open

	For I = 0 to Ubound( aTarget )
		Rs.AddNew
		Rs.Fields("ソート").Value = aTarget(I)
		Rs.Update
	Next

	if bDesc then
		Rs.Sort = "ソート desc"
	else
		Rs.Sort = "ソート"
	end if

	Rs.MoveFirst
	aTarget = Array()

	Do while not Rs.EOF
		Call ArrayAdd( aTarget, Rs.Fields("ソート").Value )
		Rs.MoveNext
	Loop

	Rs.Close

	ArraySort = aTarget

End Function
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ