D.O-Ultimatum vs ディープステート ― 空間クリエーターの戦い
D.Oはディープステートに追われる身となり、彼の仲間たちも危険にさらされる。彼らはディープステートの手先たちや魔法使いたちと激しい戦いを繰り広げながら、ディープステートの陰謀を阻止するために奮闘する。
ディープステートは巧妙な手口でD.Oを追い詰めてくる。彼らはディープウェブや暗号通貨を利用し、様々な手段でD.Oを攻撃してくる。しかし、D.Oは空間を操る力を使いながら、ディープステートとの戦いに立ち向かっていく。
D.O-Ultimatum vs DS ― 空間クリエーターの戦い
D.O-Ultimatumは、ディープステートという組織の存在を知った。ディープステートは裏で世界を操る陰の組織であり、様々な陰謀を企てていた。彼らは政府や企業を操り、世界を支配しようとしていた。
D.Oはディープステートの脅威を止めるため、自らの力を駆使して戦いを挑むことを決意する。彼は仲間たちを集め、ディープステートの陰謀を暴くため、自らの空間クリエーターの能力を使いながら、戦いを進めていく。
範囲のデータを統括・分割
パターン pattern1(start is same value) S1■■■■■■■■■■E1 S2■■■■■■■■■■□□□□□□□□□□□E2 pattern2 S1■■■■■■■■■■■■■■■■■■E1 □□□□□□□S2■■■■■■■■■■■■■■■■■■■■■■■E2 pattern3(END is same value) S1■■■■■■■■■■■■■■■■■■E1 □□□□□□□S2■■■■■■■■■■■E2 pattern4(all same) S1■■■■■■■■■■■■■■■■■■E1 S2■■■■■■■■■■■■■■■■■■E2 pattern4(all same) S1■■■■■■■■■■■■■■■■■■E1 □□□S2■■■■■■■■■■■E2□□□□ サンプル S1■■■■■■■■■■■■■■■■■■E1 □□□□□□□S2■■■■■■■■■■■■■■■■■■■■■■■E2 S1■■■■■■■■■■■■■■■■■■E1 □□□S2■■■■■■■■■■■E2□□□□ 必要なデータ S1 S2 (S2-1) Emin = Min(E1,E2) Emax = Max(E1,E2) 開始・終了を決める Sa = S1 Ea = S2-1 Sb = S2 Eb = Emin Sc = Emin + 1 Ec = Emax source code Dim S1 As String Dim E1 As String Dim S2 As String Dim E2 As String Dim Emin As String Dim Emax As String S1 = tbl.Rows(idx).Items("S").ToString() E1 = tbl.Rows(idx).Items("E").ToString() S2 = tbl.Rows(idx+1).Items("S").ToString() E2 = tbl.Rows(idx+1).Items("E").ToString() Emin = Math.Min(E1,E2) Emax = Math.Max(E1,E2) 1行目 Dim Sa As String Dim Ea As String Sa = S1 Ea = S2-1 2行目 Dim Sb As String Dim Eb As String Sb = S2 Eb = Emin 3行目 Dim Sb As String Dim Eb As String Sb = Emin + 1 Eb = Emax
複数テーブルの範囲データを統合・分割する方法
下記のようなデータパターンを統合する方法
pattern1(start is same value)
S1■■■■■■■■■■E1
S2■■■■■■■■■■□□□□□□□□□□□E2
pattern2
S1■■■■■■■■■■■■■■■■■■E1
□□□□□□□S2■■■■■■■■■■■■■■■■■■■■■■■E2
pattern3(END is same value)
S1■■■■■■■■■■■■■■■■■■E1
□□□□□□□S2■■■■■■■■■■■E2
pattern4(all same)
S1■■■■■■■■■■■■■■■■■■E1
S2■■■■■■■■■■■■■■■■■■E2
・データのソートを実施することでデータのパターンは4パターンに絞られます。
'【クラス】 Public Class ClsDataMerge ''' <summary> ''' データマージ処理 ''' </summary> ''' <param name="dtTable"></param> Public Function ExecuteDataMerge(ByRef dtTable As DataTable) As Double Dim dblResult As Double = 0 Try Dim idx As Double Dim idxMax As Double = dtTable.Rows.Count - 2 'DELETE DeleteData(dtTable) 'ChangeAccept dtTable.AcceptChanges() 'SORT SortTBL(dtTable) For idx = 0 To idxMax Dim S1 As String Dim E1 As String Dim S2 As String Dim E2 As String Dim S3 As String Dim E3 As String '現在行を取得 S1 = dtTable.Rows(idx).Item("S").ToString() E1 = dtTable.Rows(idx).Item("E").ToString() S2 = dtTable.Rows(idx + 1).Item("S").ToString() E2 = dtTable.Rows(idx + 1).Item("E").ToString() S3 = "" E3 = "" If (S1 <= S2) And (S2 <= E1) Then dblResult = dblResult + 1 ' まったく同じ場合は一個下を削除するのみで良い If S1 = S2 And E1 = E2 Then dtTable.Rows(idx + 1).Item("DEL") = 1 Continue For End If S3 = S2 E3 = E1 E1 = (S2 - 1).ToString("000000") S2 = (E1 + 1).ToString("000000") dtTable.Rows(idx).Item("E") = E1 dtTable.Rows(idx + 1).Item("S") = S2 '新規Row作成 Dim rwNEW As DataRow rwNEW = dtTable.NewRow() rwNEW.Item("S") = S3 rwNEW.Item("E") = E3 ' データカラムがある場合(DATA1,DATA2が影響を受けない) Dim sNewData As String = Convert.ToString(dtTable.Rows(idx).Item("DATA")) Dim sAddData() As String = Convert.ToString(dtTable.Rows(idx + 1).Item("DATA")).Replace(",,", ",").Split(",") If sAddData.Length > 0 Then ' 既に含まれているデータは追加しない For i As Integer = 0 To UBound(sAddData) If String.IsNullOrEmpty(sAddData(i).Trim) Then Continue For If sNewData.Contains(sAddData(i)) = False Then sNewData = sNewData & "," & sAddData(i) End If Next End If rwNEW.Item("DATA") = sNewData 'データの整合性チェック CheckDataValue(dtTable.Rows(idx)) CheckDataValue(dtTable.Rows(idx + 1)) CheckDataValue(rwNEW) 'とりあえず追加してしまう dtTable.Rows.Add(rwNEW) End If Next Catch ex As Exception End Try Return dblResult End Function ''' <summary> ''' 削除フラグを設定 ''' </summary> ''' <param name="rwTarget"></param> Private Sub CheckDataValue(ByRef rwTarget As DataRow) If rwTarget.Item("S").ToString() > rwTarget.Item("E").ToString() Then rwTarget.Item("DEL") = 1 End If End Sub ''' <summary> ''' 実際の削除処理 ''' </summary> ''' <param name="dtTable"></param> Private Sub DeleteData(ByRef dtTable As DataTable) Try For Each rwDEL As DataRow In dtTable.Rows ' 実際に削除 If rwDEL.Item("DEL").ToString() = "1" Then rwDEL.Delete() End If Next dtTable.AcceptChanges() Catch ex As Exception End Try End Sub ''' <summary> ''' 最終処理 ''' </summary> ''' <param name="dtTable"></param> Public Sub DataFinish(ByRef dtTable As DataTable) Try For Each rwItem As DataRow In dtTable.Rows CheckDataValue(rwItem) Next 'DELETE DeleteData(dtTable) 'ChangeAccept dtTable.AcceptChanges() 'SORT SortTBL(dtTable) Catch ex As Exception End Try End Sub ''' <summary> ''' ソート ''' </summary> ''' <param name="dtTable"></param> Private Sub SortTBL(ByRef dtTable As DataTable) Try 'DataTable.Select()を使いソート(第二引数にソート条件を書く) Dim rows As DataRow() = dtTable.Select(Nothing, "S ASC , E ASC").Clone() 'ソート後の DataTable を用意 Dim dtWort As DataTable = dtTable.Clone 'ソートされてる DataRow 配列をソート後の DataTable に追加 For Each row As DataRow In rows dtWort.ImportRow(row) Next dtWort.AcceptChanges() dtTable = dtWort Catch ex As Exception End Try End Sub ''' <summary> ''' データテーブル作成（データ無しテンプレート） ''' </summary> ''' <returns></returns> Public Function CreateTemplateDataTable() As DataTable Dim dtTBL As New DataTable Try dtTBL.Columns.Add("S") dtTBL.Columns.Add("E") dtTBL.Columns.Add("DATA") dtTBL.Columns.Add("DEL") dtTBL.AcceptChanges() Catch ex As Exception End Try Return dtTBL End Function End Class
‘ フォームから呼び出します Public Class Form1 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim cMG As New ClsDataMerge() Try ' テーブル初期化 Dim tblDataTable As New DataTable tblDataTable = cMG.CreateTemplateDataTable() ' データ格納 For Each s As String In Me.RichTextBox1.Lines Dim sItem() As String sItem = s.Split(",") Dim rwNew As DataRow = tblDataTable.NewRow rwNew.Item("S") = sItem(0) rwNew.Item("E") = sItem(1) If sItem.Length > 2 Then For i As Integer = 2 To UBound(sItem) If String.IsNullOrEmpty(sItem(i)) Then Continue For rwNew.Item("DATA") = Convert.ToString(rwNew.Item("DATA")) & "," & sItem(i) Next End If rwNew.Item("DEL") = "0" tblDataTable.Rows.Add(rwNew) Next tblDataTable.AcceptChanges() ' マージ処理 Dim result As Double = 1 While (result = 1) result = cMG.ExecuteDataMerge(tblDataTable) End While ' 最終整理 cMG.DataFinish(tblDataTable) Me.DataGridView1.DataSource = tblDataTable Catch ex As Exception End Try End Sub End Class
範囲/枠（FromとTo）データを分割/統合するベースとなるアルゴリズム
![【ポイント10倍】iiyama STYLE∞ ミニタワーPC STYLE-M1B6-i7-UH-M [Windows 10 Home/Core i7-8700/8GB メモリ/1TB HDD][イイヤマ][BTOパソコン][送料無料]](https://thumbnail.image.rakuten.co.jp/@0_mall/pckoubou/cabinet/99/m4s1p632609_1.jpg?_ex=128x128 "【ポイント10倍】iiyama STYLE∞ ミニタワーPC STYLE-M1B6-i7-UH-M [Windows 10 Home/Core i7-8700/8GB メモリ/1TB HDD][イイヤマ][BTOパソコン][送料無料]")
Start(S)列とEnd(E)列で昇順にソートしておくと、
データの並び順は以下の４パターンに分類されます。
pattern1(start is same value)
S1■■■■■■■■■■E1
S2■■■■■■■■■■□□□□□□□□□□□E2
pattern2
S1■■■■■■■■■■■■■■■■■■E1
□□□□□□□S2■■■■■■■■■■■■■■■■■■■■■■■E2
pattern3(END is same value)
S1■■■■■■■■■■■■■■■■■■E1
□□□□□□□S2■■■■■■■■■■■E2
pattern4(all same)
S1■■■■■■■■■■■■■■■■■■E1
S2■■■■■■■■■■■■■■■■■■E2
''' <summary> ''' 例）呼び出し方 ''' </summary> Private Sub ExecSplitAndConsolidateRangeData() ' Init Class Dim clsCTRL As New ClsSplitAndConsolidateRangeData() ' DataTable Dim datTable As New DataTable ' Create Initial DataTable clsCTRL.InitializeDataTable(datTable) ' データ作成 For Each s As String In Me.RichTextBox1.Lines Dim rwNew As DataRow = datTable.NewRow Dim sItems() As String = s.Split(",") rwNew(0) = sItems(0) rwNew(1) = sItems(1) datTable.Rows.Add(rwNew) Next ' 変換されたデータが0件になるまで続ける Dim result As Double = 1 While (result > 0) ' 呼出し result = clsCTRL.SplitAndConsolidateRangeData(datTable) End While ' データをセット Me.DataGridView1.DataSource = datTable End Sub
★ここからがデータを整合性を保ちながら分割・統合するクラス
''' <summary> ''' 範囲（From～To,Start～End...etc）からなるデータを統合、分割する方法 ''' </summary> Public Class ClsSplitAndConsolidateRangeData ' 変数宣言エリア Public Const S As String = "S" '開始 Public Const E As String = "E" '終了 Public Const FORMAT As String = "000000" Public Const DATA As String = "DATA" 'データエリア Public Const DEL As String = "DEL" ' 削除対象フラグ ' クラス内テーブル Public TBL_MAIN As New DataTable() ''' <summary> ''' 削除対象フラグ ''' </summary> Enum DELFLAG DEL NONE End Enum ''' <summary> ''' データテーブルを初期化する ''' </summary> ''' <param name="DATA_TABLE"></param> Public Sub InitializeDataTable(ByRef DATA_TABLE As DataTable) Try DATA_TABLE = New DataTable() DATA_TABLE.Columns.Add(S, Type.GetType("System.String")) DATA_TABLE.Columns.Add(E, Type.GetType("System.String")) DATA_TABLE.Columns.Add(DATA, Type.GetType("System.String")) DATA_TABLE.Columns.Add(DEL, Type.GetType("System.String")) Catch ex As Exception End Try End Sub ''' <summary> ''' 実処理（分割、統合） ''' </summary> ''' <param name="TBL_TARGET"></param> Public Function SplitAndConsolidateRangeData(ByRef TBL_TARGET As DataTable) As Double ' 何件更新したか？0件になるまで再帰呼出し Dim dblResult As Double = 0 Try ' インデックス：カレント行 Dim idx As Double ' インデックス：最大行 Dim idxMax As Double = TBL_TARGET.Rows.Count - 2 'SORT TBL_TARGET = SortDataTable(TBL_TARGET, S & " Asc, " & E & " Asc ") 'DELETE DeleteRowData(TBL_TARGET) 'ChangeAccept TBL_TARGET.AcceptChanges() ' 現在行と次の行を比較していく For idx = 0 To idxMax ' 元データ格納 Dim _S1 As String ' 開始1 Dim _E1 As String ' 終了1 Dim _S2 As String ' 開始2 Dim _E2 As String ' 終了3 Dim _S3 As String ' 開始new Dim _E3 As String ' 終了new ' 加工済みデータ格納用 Dim E1 As String ' 終了1 Dim S2 As String ' 開始2 Dim S3 As String ' 開始new Dim E3 As String ' 終了new '現在行を取得 _S1 = TBL_TARGET.Rows(idx).Item(S).ToString() _E1 = TBL_TARGET.Rows(idx).Item(E).ToString() '次の行を取得 _S2 = TBL_TARGET.Rows(idx + 1).Item(S).ToString() _E2 = TBL_TARGET.Rows(idx + 1).Item(E).ToString() '新しく作成される行 _S3 = "" _E3 = "" ' 重複範囲がある場合は分割/統合対象 If (_S1 <= _S2) And (_S2 <= _E1) Then ' 影響を受けたデータをカウント dblResult = dblResult + 1 ' データの成形 S3 = _S2 E3 = _E1 E1 = (CDbl(_S2) - 1).ToString(FORMAT) S2 = (CDbl(_E1) + 1).ToString(FORMAT) TBL_TARGET.Rows(idx).Item(E) = E1 TBL_TARGET.Rows(idx + 1).Item(S) = S2 '新規Row作成 Dim rwNEW As DataRow rwNEW = TBL_TARGET.NewRow() rwNEW.Item(S) = S3 'または、_S2でもOK rwNEW.Item(E) = E3 'または、_E1でもOK ' データカラムがある場合(DATA1,DATA2が影響を受けない) rwNEW.Item(DATA) = TBL_TARGET.Rows(idx).Item(DATA) & TBL_TARGET.Rows(idx + 1).Item(DATA) 'データの整合性チェック(削除フラグを設定する) CheckDataValue(TBL_TARGET.Rows(idx)) CheckDataValue(TBL_TARGET.Rows(idx + 1)) CheckDataValue(rwNEW) 'とりあえず追加してしまう（Rows.Addメソッドだと必ず最後尾に追加） TBL_TARGET.Rows.Add(rwNEW) End If Next Catch ex As Exception Finally TBL_TARGET.AcceptChanges() End Try Return dblResult End Function ''' <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) As DataTable 'ソート後の 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> ''' 削除フラグを設定する ''' </summary> ''' <param name="rwTarget"></param> Private Sub CheckDataValue(ByRef rwTarget As DataRow) Try ' 開始＞終了は不整合データで削除 If rwTarget.Item(S).ToString() > rwTarget.Item(E).ToString() Then rwTarget.Item(DEL) = CDbl(DELFLAG.DEL) End If Catch ex As Exception End Try End Sub ''' <summary> ''' 実際にテーブルから削除する ''' </summary> ''' <param name="DEL_TABLE"></param> Private Sub DeleteRowData(ByRef DEL_TABLE As DataTable) For Each rwDEL As DataRow In DEL_TABLE.Rows ' 実際に削除 If rwDEL.Item(DEL).ToString() = CStr(CDbl(DELFLAG.DEL)) Then rwDEL.Delete() End If Next DEL_TABLE.AcceptChanges() End Sub End Class
プログラミングにおすすめのパソコン：：Core i7 8gb
Lenovo ノートパソコン ideapad 330 15.6型FHD Corei i7搭載/8GBメモリー/256GB SSD/Office搭載/プラチナグレー/81DE01KAJP
- 出版社/メーカー: Lenovo
- 発売日: 2018/09/14
- メディア: Personal Computers
- この商品を含むブログを見る
Start(S)列とEnd(E)列で昇順にソートしておくと、
データの並び順は以下の４パターンに分類されます。
pattern1(start is same value)
S1■■■■■■■■■■E1
S2■■■■■■■■■■□□□□□□□□□□□E2
pattern2
S1■■■■■■■■■■■■■■■■■■E1
□□□□□□□S2■■■■■■■■■■■■■■■■■■■■■■■E2
pattern3(END is same value)
S1■■■■■■■■■■■■■■■■■■E1
□□□□□□□S2■■■■■■■■■■■E2
pattern4(all same)
S1■■■■■■■■■■■■■■■■■■E1
S2■■■■■■■■■■■■■■■■■■E2
Acer デスクトップパソコン Aspire (Core i7-8700/8GB/2TB HDD/±R/RW スリムドライブ/Windows 10/ブラック) XC-885-N78H
- 出版社/メーカー: 日本エイサー
- 発売日: 2018/06/30
- メディア: Personal Computers
- この商品を含むブログを見る
'新しい行を作成 Create new DataRow. Set S2 to S(New) Set E1 to E(New) '既存のデータを加工 Set S3(S2-1) to E1 Set E3(E1+1) to S2
- メディア:
- この商品を含むブログを見る
２つのテーブルデータをマージする方法（From～Toデータ）
''' <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
