Public Class ClsDataTableMerge
Public sOK As Boolean
Public eOK As Boolean
Const COL_START_NEWRNG = 1
Const COL_END_NEWRNG = 2
Const COL_START_TARGET = 1
Const COL_END_TARGET = 2
Public Sub MergeDataTables(ByRef _TBL_TARGER As DataTable, ByRef _TBL_NEWRNGE As 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
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
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
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)
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) - 1, "000000")
_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)
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
GoTo CONT_FOR1
End If
If (strSTART_NEWRNG_CRNT = strSTART_TARGET_CRNT) Then
sOK = True
If (strEND_TARGET_CRNT < strEND_NEWRNG_CRNT) Then
GoTo TO_END1
End If
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strSTART_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) + 1, "000000")
GoTo TO_END1
End If
If (strSTART_NEWRNG_CRNT = strEND_TARGET_CRNT) Then
sOK = True
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) - 1, "000000")
GoTo TO_END1
End If
If (strSTART_NEWRNG_CRNT > strSTART_TARGET_CRNT) And (strSTART_NEWRNG_CRNT < strEND_TARGET_CRNT) Then
sOK = True
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strSTART_NEWRNG_CRNT) - 1, "000000")
GoTo TO_END1
End If
If (strSTART_NEWRNG_CRNT > strEND_TARGET_CRNT) And (strSTART_NEWRNG_CRNT < strSTART_TARGET_NEXT) Then
sOK = True
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strSTART_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_END_TARGET) = Format(CLng(strSTART_TARGET_NEXT) - 1, "000000")
GoTo TO_END1
End If
TO_END1:
If (strEND_NEWRNG_CRNT = strSTART_TARGET_CRNT) Then
eOK = True
If (strSTART_NEWRNG_CRNT < strSTART_TARGET_CRNT) Then
GoTo CONT_FOR1
End If
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) + 1, "000000")
GoTo CONT_FOR1
End If
If (strEND_NEWRNG_CRNT = strEND_TARGET_CRNT) Then
eOK = True
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = strEND_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) - 1, "000000")
GoTo CONT_FOR1
End If
If (strEND_NEWRNG_CRNT > strSTART_TARGET_CRNT) And (strEND_NEWRNG_CRNT < strEND_TARGET_CRNT) Then
eOK = True
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
_TBL_TARGER.Rows((idx_TARGET + 1)).Item(COL_START_TARGET) = Format(CLng(strEND_NEWRNG_CRNT) + 1, "000000")
GoTo CONT_FOR1
End If
If (strEND_NEWRNG_CRNT > strSTART_TARGET_CRNT) And (strEND_NEWRNG_CRNT < strSTART_TARGET_NEXT) Then
eOK = True
CopyInsertDown(_TBL_TARGER, idx_TARGET)
_TBL_TARGER.Rows((idx_TARGET)).Item(COL_END_TARGET) = strEND_NEWRNG_CRNT
_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
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
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 "補助機能"
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
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
Public Function SortDataTable(ByVal tblTarget As DataTable, ByVal sortText As String)
Dim dtblSrt As New DataTable()
Try
dtblSrt = tblTarget.Clone()
Dim rows As DataRow() = tblTarget.Select(Nothing, sortText).Clone()
For Each row As DataRow In rows
dtblSrt.ImportRow(row)
Next
Catch ex As Exception
End Try
Return dtblSrt
End Function
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