枠の分割を行うアルゴリズムVB.NET

'-----------------------------------------------------------------
' 名称を明確に統一（変更しました。）
' TARGET:分割される側につける（接頭or接尾）
' NEWRNG:分割する側につける（接頭or接尾）
' CRNT:カレント行
' PREV:１個前の行
' NEXT:１個次の行
'-----------------------------------------------------------------
 
Public Class ClsDataTableMerge
	' 【定数、変数定義領域】
	' 開始フラグ：１行データごとに処理したらTrueになる（NEWRNG側）
    Public sOK As Boolean
	' 終了フラグ：１行データごとに処理したらTrueになる（NEWRNG側）
    Public eOK As Boolean
	' 分割する側の列：NEWRNG
    Const COL_START_NEWRNG = 1
    Const COL_END_NEWRNG = 2
	' 分割される側の列：TARGET
    Const COL_START_TARGET = 1
    Const COL_END_TARGET = 2
 
	'【仕様】
	' 分割するパターンはいくつあるか？⇛下記の１３パターンになる。
	' パターンALL【分割される側の】開始番号、終了番号を同時にみる
	'①範囲が完全一致
	' S----------------------------E
	' S----------------------------E
	'②範囲が完全に含まれる
	' S----------------------------E
    '  	S-----------------E
	'③行を跨いで完全に含まれる
	' S----------------------------E
    '  	S-----------------E     	
	' S----------------------------E
 
    ''' <summary>
    ''' 2つのテーブルをマージして連番の整合性を保つ処理
    ''' </summary>
    ''' <param name="_TBL_TARGER"></param>
    ''' <param name="_TBL_NEWRNGE"></param>
    Public Sub MergeDataTables(ByRef _TBL_TARGER As DataTable, ByRef _TBL_NEWRNGE As DataTable)
        ' @
        ' @ _TBL_TARGER:分割される側のDataTable
        ' @ _TBL_NEWRANGE:分割する側のDataTable
        ' @
        ' 分割される側のインデックス
        Dim idx_TARGET As Double
        Const MAX_TARGET As Double = Double.MaxValue
 
        '分割する側のインデックス
        Dim idx_NEWRNG As Double
        Const MAX_NEWRNG As Double = Double.MaxValue
 
        Try
            ' 分割する側(NEWRNG)のデータ側でループ
            For idx_NEWRNG = 0 To MAX_NEWRNG
            	Application.DoEvents()
            	' フラグ初期化
            	sOK = False
            	eOK = False
 
            	'カレントデータを保存
            	Dim strSTART_NEWRNG_CRNT As String
            	Dim strEND_NEWRNG_CRNT As String
 
            	' 件数を超えていたら終了
            	If idx_NEWRNG > _TBL_NEWRNGE.Rows.Count - 1 Then Exit Sub
 
            	'分割する側のデータを取得（カレント）
            	strSTART_NEWRNG_CRNT = _TBL_NEWRNGE.Rows(idx_NEWRNG).Item(COL_START_NEWRNG)
            	strEND_NEWRNG_CRNT = _TBL_NEWRNGE.Rows(idx_NEWRNG).Item(COL_END_NEWRNG)
 
            	'分割する側が空白になったら終了
            	If strEND_NEWRNG_CRNT = "" Or strSTART_NEWRNG_CRNT = "" Then
                	Exit Sub
            	End If
 
            	' 分割される側(TARGET)でループ
            	For idx_TARGET = 0 To MAX_TARGET
                	Application.DoEvents()
                	'一個前のデータ
                	Dim strSTART_TARGET_PREV As String
                	Dim strEND_TARGET_PREV As String
                	'カレントデータ
                	Dim strSTART_TARGET_CRNT As String
                	Dim strEND_TARGET_CRNT As String
                	'次のデータ
                	Dim strSTART_TARGET_NEXT As String
                	Dim strEND_TARGET_NEXT As String
 
                	'一個前のデータを取得
                	If idx_TARGET > 0 Then
                    	strSTART_TARGET_PREV = _TBL_TARGER.Rows((idx_TARGET - 1)).Item(COL_START_TARGET)
                    	strEND_TARGET_PREV = _TBL_TARGER.Rows((idx_TARGET - 1)).Item(COL_END_TARGET)
                	End If
 
                	'カレントデータ取得
                	strSTART_TARGET_CRNT = _TBL_TARGER.Rows(idx_TARGET).Item(COL_START_TARGET)
                	strEND_TARGET_CRNT = _TBL_TARGER.Rows(idx_TARGET).Item(COL_END_TARGET)
                	'次の行のデータ
                	strSTART_TARGET_NEXT = _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET)
                	strEND_TARGET_NEXT = _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_END_TARGET)
 
                	'空白に達したらループを抜ける
                	If strSTART_TARGET_CRNT = "" Or strSTART_TARGET_CRNT = "" Then
                    	GoTo CONT_FOR1
                	End If
 
                    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                	'この部分に具体的な処理を書いていく
 
                	' ① 範囲が完全一致　=　既に同じデータがあるので何もしない
                	If (strSTART_NEWRNG_CRNT = strSTART_TARGET_CRNT) And (strEND_NEWRNG_CRNT = strEND_TARGET_CRNT) Then
                    	sOK = True
                    	eOK = True
                    	GoTo CONT_FOR1
                	End If
 
                	' ② 範囲が完全に含まれる 挿入×2 S2にS E2にE E1にS-1 S3にE+1
                    If (strSTART_NEWRNG_CRNT > strSTART_TARGET_CRNT) And (strEND_NEWRNG_CRNT < strEND_TARGET_CRNT) Then
                    	sOK = True
                    	eOK = True
                    	' 挿入
                    	CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	' 挿入
                        CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	' S2にS
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
                        ' E2にE
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
                    	' E1にS-1
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) - 1, "000000")
                    	' S3にE+1
                        _TBL_TARGER.Rows((idx_TARGET + 2)).Item(COL_START_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) + 1, "000000")
                    	' 処理終わり
                    	GoTo CONT_FOR1
                	End If
 
                	' ③　行を跨いで完全に含まれる
                	If (strSTART_NEWRNG_CRNT > strEND_TARGET_CRNT) And (strEND_NEWRNG_CRNT < strSTART_TARGET_NEXT) Then
                    	sOK = True
                    	eOK = True
                    	' 挿入
                        CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	' S2にS
                    	_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
                    	' E2にE
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
                    	' 処理終わり
          	          GoTo CONT_FOR1
                	End If
 
                	'■■■■開始（START）番号チェック■■■■■■■■■
 
                	'①strSTART_NEWRNG_CRNTとstrSTART_TARGET_CRNTが一致したら、
                	'　1行下に挿入
                	'　現行の終了にstrSTART_NEWRNG_CRNTに設定
                	'　次行の開始に(strSTART_NEWRNG_CRNT + 1)を設定
                	If (strSTART_NEWRNG_CRNT = strSTART_TARGET_CRNT) Then
                    	sOK = True
                    	' ただし現行終了(NEWRNG)が現行終了(TARGET)を超えていたら分割不要
                    	If (strEND_TARGET_CRNT < strEND_NEWRNG_CRNT) Then
                        	' 処理終わり
                        	GoTo TO_END1
                    	End If
                    	' 挿入
                    	CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	'　現行の終了にstrSTART_NEWRNG_CRNTに設定
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strSTART_NEWRNG_CRNT
                    	'　次行の開始に(strSTART_NEWRNG_CRNT + 1)を設定
                	    _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) + 1, "000000")
                    	' 処理終わり
                    	GoTo TO_END1
                	End If
 
                	'②strSTART_NEWRNG_CRNTとstrEND_TARGET_CRNTが一致
                	'　1行下に挿入
                	'　次行の開始にstrSTART_NEWRNG_CRNTセット
                	'　現業の終了に(strSTART_NEWRNG_CRNT - 1)セット
                	If (strSTART_NEWRNG_CRNT = strEND_TARGET_CRNT) Then
                    	sOK = True
                    	' 挿入
                        CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	' S2にSセット
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
           	         '　次行の開始にstrSTART_NEWRNG_CRNTセット
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) - 1, "000000")
                    	'　現業の終了に(strSTART_NEWRNG_CRNT - 1)セット
                    	GoTo TO_END1
                	End If
 
                	'③開始と終了に挟まれる場合 strSTART_TARGET_CRNT　＜ strSTART_NEWRNG_CRNT ＜ strEND_TARGET_CRNT
                	'　1行下に挿入
                	'　次行の開始にstrSTART_NEWRNG_CRNTセット
                	'　現業の終了に(strSTART_NEWRNG_CRNT - 1)
                	If (strSTART_NEWRNG_CRNT > strSTART_TARGET_CRNT) And (strSTART_NEWRNG_CRNT < strEND_TARGET_CRNT) Then
                    	sOK = True
                    	' 挿入
           	         CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	'　次行の開始にstrSTART_NEWRNG_CRNTセット
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
                    	'　現業の終了に(strSTART_NEWRNG_CRNT - 1)
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) - 1, "000000")
                    	' 処理終わり
                    	GoTo TO_END1
                	End If
 
                	'④ 現行の終了と次行の開始の間　strEND_TARGET_CRNT　＜　strSTART_NEWRNG_CRNT　＜ strSTART_TARGET_NEXT
                	'　1行下に挿入
                	'　次行の開始にstrSTART_NEWRNG_CRNTセット
                	'　次行の終了に(strSTART_TARGET_NEXT - 1)
              	  If (strSTART_NEWRNG_CRNT > strEND_TARGET_CRNT) And (strSTART_NEWRNG_CRNT < strSTART_TARGET_NEXT) Then
                    	sOK = True
                    	' 挿入
                        CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	'　次行の開始にstrSTART_NEWRNG_CRNTセット
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
                    	'　次行の終了に(strSTART_TARGET_NEXT - 1)
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_END_TARGET) = Format(CLng(strSTART_TARGET_NEXT) - 1, "000000")
                    	' 処理終わり
                    	GoTo TO_END1
                	End If
 
TO_END1:  '開始番号終了ラベル
 
                    '■■■■終了（END）番号チェック■■■■■■■■■
                	'①現行開始と一致
                	'　1行下に挿入
                	'　現行終了にstrEND_NEWRNG_CRNTセット
                	'　次行開始に(strEND_NEWRNG_CRNT + 1)
                	If (strEND_NEWRNG_CRNT = strSTART_TARGET_CRNT) Then
                    	eOK = True
                    	' ただし現行開始(TARGET)が現行開始(NEWRNG)を超えていたら分割不要
                    	If (strSTART_NEWRNG_CRNT < strSTART_TARGET_CRNT) Then
                        	' 処理終わり
                   	     GoTo CONT_FOR1
                    	End If
                    	' 挿入
                        CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	'　現行終了にstrEND_NEWRNG_CRNTセット
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
                    	'　次行開始に(strEND_NEWRNG_CRNT + 1)
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) + 1, "000000")
                    	' 処理終わり
                    	GoTo CONT_FOR1
                	End If
 
                	'②現行終了と一致
                	'　1行下に挿入
                	'　次行の開始にstrEND_NEWRNG_CRNTセット
                	'　現行の終了に(strEND_NEWRNG_CRNT - 1)
                	If (strEND_NEWRNG_CRNT = strEND_TARGET_CRNT) Then
                    	eOK = True
                    	' 挿入
                        CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	'　次行の開始にstrEND_NEWRNG_CRNTセット
	                    _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strEND_NEWRNG_CRNT
                    	'　現行の終了に(strEND_NEWRNG_CRNT - 1)
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) - 1, "000000")
                    	' 処理終わり
                    	GoTo CONT_FOR1
                	End If
 
                	'③現行開始と現行終了の間
                	'　1行下に挿入
                	'　現行終了にstrEND_NEWRNG_CRNTセット
                	'　次行開始に(strEND_NEWRNG_CRNT + 1)
                	If (strEND_NEWRNG_CRNT > strSTART_TARGET_CRNT) And (strEND_NEWRNG_CRNT < strEND_TARGET_CRNT) Then
                    	eOK = True
                    	' 挿入
                    	CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	'　現行終了にstrEND_NEWRNG_CRNTセット
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
                    	'　次行開始に(strEND_NEWRNG_CRNT + 1)
                    	_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) + 1, "000000")
                    	' 処理終わり
                    	GoTo CONT_FOR1
                	End If
 
                	' ④現行終了と次行開始の間
                	'　1行下に挿入
                	'　現行終了にstrEND_NEWRNG_CRNTセット
                	'　次行開始に(strEND_NEWRNG_CRNT + 1)
                	If (strEND_NEWRNG_CRNT > strSTART_TARGET_CRNT) And (strEND_NEWRNG_CRNT < strSTART_TARGET_NEXT) Then
                        eOK = True
                    	' 挿入
                        CopyInsertDown(_TBL_TARGER, idx_TARGET)
                    	'　現行終了にstrEND_NEWRNG_CRNTセット
                        _TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
                    	'　次行開始に(strEND_NEWRNG_CRNT + 1)
                        _TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) + 1, "000000")
                    	' 処理終わり
                 	   GoTo CONT_FOR1
                	End If
 
 
                	'この部分に具体的な処理を書いていく
                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
CONT_FOR2:
            	Next idx_TARGET
            	''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            	'存在しない番号の処理は
            	'この部分に具体的な処理を書いていく
            	' 5 上記以外（値が見つからない） ■先頭挿入 S0にSセット E0にSX-1
            	If sOK = False Then
                    InsertEmptyData(_TBL_TARGER, 0)
                    _TBL_TARGER.Rows(0).Item(COL_END_TARGET) = Format(CLng(_TBL_TARGER.Rows(1).Item(COL_START_TARGET)) - 1, "000000")
                    _TBL_TARGER.Rows(0).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
            	End If
 
            	' 5 上記以外（値が見つからない ■最下挿入 EXにEセット SXにEX+1
            	'
            	If eOK = False Then
                    InsertEmptyData(_TBL_TARGER)
                    _TBL_TARGER.Rows(_TBL_TARGER.Rows.Count - 1).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
                    _TBL_TARGER.Rows(_TBL_TARGER.Rows.Count - 1).Item(COL_START_TARGET) = Format(CLng(_TBL_TARGER.Rows((_TBL_TARGER.Rows.Count - 1)).Item(COL_END_TARGET)) + 1, "000000")
            	End If
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
CONT_FOR1:
            Next idx_NEWRNG
 
        Catch ex As Exception
        Finally
            _TBL_NEWRNGE.AcceptChanges()
            _TBL_TARGER.AcceptChanges()
    	End Try
    End Sub

#Region "補助機能"
 
    ''' <summary>
    ''' 同じ内容の行を1個下の行に追加
    ''' </summary>
    ''' <param name="dtA"></param>
    ''' <param name="idx"></param>
    Public Sub CopyInsertDown(ByRef dtA As DataTable, ByVal idx As Double)
        Try
            Dim rwNew As DataRow
            rwNew = dtA.NewRow
            rwNew.ItemArray = dtA.Rows(idx).ItemArray
            dtA.Rows.InsertAt(rwNew, idx + 1)
        Catch ex As Exception
 
        End Try
    End Sub
 
    ''' <summary>
    ''' ~データを追加する
    ''' </summary>
    ''' <param name="dtA"></param>
    ''' <param name="idx"></param>
    Public Sub InsertEmptyData(ByRef dtA As DataTable, Optional ByVal idx As Double = -1)
        Try
            Dim rwNew As DataRow
            rwNew = dtA.NewRow
            If idx >= -1 Then
            	dtA.Rows.InsertAt(rwNew, idx)
            Else
            	dtA.ImportRow(rwNew)
            End If
        Catch ex As Exception
        End Try
    End Sub
 
    ''' <summary>
    ''' ソート対象のテーブル作成
    ''' DataTable自体にはソートをしてくれる機能がありませんが、DataTable.Select を応用することでソート処理ができます。
    ''' </summary>
    ''' <param name="tblTarget"></param>
    ''' <param name="sortText">"Age DESC , ID ASC"</param>
    ''' <returns></returns>
    Public Function SortDataTable(ByVal tblTarget As DataTable, ByVal sortText As String)
        'ソート後の DataTable を用意
        Dim dtblSrt As New DataTable()
        Try
            'ソート前テーブルの情報をクローン
            dtblSrt = tblTarget.Clone()
 
            'DataTable.Select()を使いソート(第二引数にソート条件を書く)
            Dim rows As DataRow() = tblTarget.Select(Nothing, sortText).Clone()
            'ソートされてる DataRow 配列をソート後の DataTable に追加
            For Each row As DataRow In rows
            	dtblSrt.ImportRow(row)
            Next
        Catch ex As Exception
        End Try
        Return dtblSrt
    End Function
 
    ''' <summary>
    ''' ###テストDataTable 作成###
    ''' </summary>
    ''' <param name="_TBL_NAME"></param>
    ''' <param name="dblMaxDataCnt"></param>
    ''' <param name="sPan"></param>
    ''' <returns></returns>
    Public Function CreateDataTable(ByVal _TBL_NAME As String, Optional ByVal dblMaxDataCnt As Double = 100, Optional ByVal sPan As Integer = 10) As DataTable
        Dim tbl As New DataTable(_TBL_NAME)
        tbl.Columns.Add("col1", Type.GetType("System.String"))
        tbl.Columns.Add("col2", Type.GetType("System.String"))
        tbl.Columns.Add("col3", Type.GetType("System.String"))
        tbl.Columns.Add("col4", Type.GetType("System.String"))
        tbl.Columns.Add("col5", Type.GetType("System.String"))
	    For i As Integer = 0 To dblMaxDataCnt
            Dim rwNew As DataRow
            rwNew = tbl.NewRow
            rwNew("col2") = (i + sPan).ToString("000000")
            rwNew("col3") = (i + sPan * 100).ToString("000000")
            tbl.Rows.Add(rwNew)
        Next
        tbl.AcceptChanges()
        Return tbl
    End Function
 
#End Region
 
End Class