２つのテーブルデータをマージする方法（From～Toデータ）

※12/26再入荷 当店 オススメ 新品パソコン A4 エントリークラス 東芝 dynabook Satellite B65 15.6インチ テンキー 無線LAN WPS Offce付き Windows10 Pro 【Celeron 3865U/4GB/500GB/MULTI】 【新品】 ノートパソコン

''' <summary>
''' 2つのテーブルをマージする方法
''' </summary>
Public Class ClsDataTableMerge
	'-----------------------------------------------------------------
	' 名称を明確に統一（変更しました。）
	' TARGET:分割される側につける（接頭or接尾）
	' NEWRNG:分割する側につける（接頭or接尾）
	' CRNT:カレント行
	' PREV:１個前の行
	' NEXT:１個次の行
	'-----------------------------------------------------------------
 
	' 【定数、変数定義領域】
	' 開始フラグ：１行データごとに処理したら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
 

【送料無料】ノートパソコン 新品 ASUS VivoBook A541NA-GO672T シルバーグラディエント / Celeron N3350 / 15.6型ワイド液晶 / 4GBメモリ / SSD128GB / DVDスーパーマルチドライブ / Windows10 Home / Office / 日本語キーボード