'***************************************************************************************************
' Excelへのデータ貼り付けテスト(処理フォーム:参照設定版) dlgExcelSyoriE(Form)
'
' ※Excelワークシートへのデータ貼り付けの方法による処理時間を計測してみます。
' データは単なる1からの連番ですが、100列×1000行で、つまり10万件です。
' 4種類の方法は、
' ・1セルずつ直接数値データを貼り付ける
' ・1行ずつ一次配列変数に格納してから1行(100列)単位にデータを貼り付ける
' ・100列×1000行の二次元配列にデータをセットしてから全体を一回で貼り付ける
' ・一旦JAG配列に格納してから二次元配列に変換させて全体を一回で貼り付ける
' となります。処理後に処理時間をメッセージ表示します。
'
' ※もう一つですが、このような一括系処理をWindowsフォームで行なう場合の問題で
' 処理中にオペレータが他のボタンをクリックしてしまうとか、フォーム自体を
' 閉じてしまう、といったことが起きる可能性があります。
' そこでオペレータに処理中であることが視覚的に判るようにサブフォームを開いて
' そのサブフォーム側で実際の処理を行なうようにしてみました。
' サブフォームはモーダル(TopMost)にしてControlBox=Falseとして処理中は
' 閉じられないようにしてプログレスバーで処理進捗が判るようにしています。
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容---------------------------------------------------------------------->
' 09/06/21(1.0.0.0)新規作成
' 17/04/16(1.0.1.0)記述統制見直し、GP_SYORI_MODE4の追加
' 17/04/21(1.0.1.0)Excel関連クラス統合作業
'***************************************************************************************************
Imports Microsoft.Office.Interop
Friend Class dlgExcelSyoriE
'===============================================================================================
Private Const g_cnsTitle As String = "Excelへのデータ貼り付けテスト"
' セルに貼り付ける値の範囲
Private Const g_cnsIX_MIN As Integer = 1
Private Const g_cnsIX_MAX As Integer = 100000
' カラム数
Private Const g_cnsCOLCNT As Integer = 100
'-----------------------------------------------------------------------------------------------
' 親フォームとの受け渡し用変数
Private g_intSYORI_MODE As Integer ' 処理モード
Private g_tspSYORI_JIKAN As TimeSpan ' 処理時間
'***********************************************************************************************
' ■■■ フォームイベント ■■■
'***********************************************************************************************
'* 処理名 :Form_Shown
'* 機能 :フォームイベント(Shown)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(既定)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2009年06月21日
'* 作成者 :井上 治
'* 更新日 :2017年04月21日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub Form_Shown(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles Me.Shown
'-------------------------------------------------------------------------------------------
With Me
With .ProgressBar1
.Minimum = g_cnsIX_MIN
.Maximum = g_cnsIX_MAX
.Value = g_cnsIX_MIN
End With
.Refresh()
End With
Application.DoEvents()
'-------------------------------------------------------------------------------------------
Dim objWbk As Excel.Workbook = Nothing ' Excel.Workbook
' Excel出力クラスの初期化(Escキーのイベントはクラス側に実装済)
Using clsExcel = New clsAboutExcel1(Me, True)
'---------------------------------------------------------------------------------------
Dim strMSGHeader As String = String.Empty ' メッセージヘッダ
Try
'-------------------------------------------
' Excel出力(処理本体)
Call GP_MakeExcelSheet(clsExcel, objWbk, strMSGHeader)
Catch ex As Exception
'-------------------------------------------
' 処理中例外メッセージの表示
Call clsExcel.ShowFatalMessage(g_cnsTitle, strMSGHeader, ex.Message)
' 例外時後始末(但しExcel応答無しなどではここでの対応は働かない!)
Call clsExcel.SuspendExcelProc(objWbk)
End Try
'---------------------------------------------------------------------------------------
End Using
'-------------------------------------------------------------------------------------------
' 閉じる
Me.Close()
End Sub
'***********************************************************************************************
' ■■■ サブ処理 ■■■
'***********************************************************************************************
'* 処理名 :GP_MakeExcelSheet
'* 機能 :Excel出力(処理本体)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = Excel出力クラス(Object)
'* Arg2 = Excel.Workbook(Object)
'* Arg3 = 例外時メッセージヘッダ(String) ※Ref参照
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年04月21日
'* 作成者 :井上 治
'* 更新日 :2017年04月21日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:本処理中の例外は上位でトラップされる(この処理内ではトラップしない)
'***********************************************************************************************
Private Sub GP_MakeExcelSheet(ByRef clsExcel As clsAboutExcel1, _
ByRef objWbk As Excel.Workbook, _
ByRef strMSGHeader As String)
'-------------------------------------------------------------------------------------------
strMSGHeader = "Excel起動中"
' Excel起動(新規ワークブック)
If Not clsExcel.GetWorkbook(String.Empty, objWbk, strMSGHeader, True) Then Exit Sub
Dim objSH As Excel.Worksheet = objWbk.Worksheets(1) ' Excel.Worksheet
'-------------------------------------------------------------------------------------------
' 時間計測開始
Dim dteSTART_TIME As Date = Now
strMSGHeader = "Excel出力中"
'-------------------------------------------------------------------------------------------
' 画面描画停止等
Call clsExcel.StopScreenUpdate()
'-------------------------------------------------------------------------------------------
' 処理モードによる分岐
Select Case g_intSYORI_MODE
Case 1
Call GP_SYORI_MODE1(objSH)
Case 2
Call GP_SYORI_MODE2(objSH)
Case 3
Call GP_SYORI_MODE3(objSH)
Case 4
Call GP_SYORI_MODE4(objSH)
End Select
'-------------------------------------------------------------------------------------------
' 画面描画再開等終了処理
Call clsExcel.SuspendExcelProc(objWbk, True)
'-------------------------------------------------------------------------------------------
' 時間計測終了
Dim dteFINISH_TIME As Date = Now
g_tspSYORI_JIKAN = dteFINISH_TIME - dteSTART_TIME
End Sub
'***********************************************************************************************
'* 処理名 :GP_SYORI_MODE1
'* 機能 :処理モード=1の処理
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 処理対象シート(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2009年06月21日
'* 作成者 :井上 治
'* 更新日 :2017年04月21日
'* 更新者 :井上 治
'* 機能説明:1セルずつ直接数値データを貼り付ける
'* 注意事項: ⇒引数は処理対象ワークシート
'***********************************************************************************************
Private Sub GP_SYORI_MODE1(ByRef objSH As Excel.Worksheet)
'-------------------------------------------------------------------------------------------
Dim intIx As Integer = g_cnsIX_MIN ' テーブルINDEX
Dim intRow As Integer = 0 ' 行INDEX
Dim intCol As Integer ' カラムINDEX
With objSH
' 全体ループ
Do While intIx <= g_cnsIX_MAX
' 行単位処理
intRow += 1 ' 行を加算
intCol = 1 ' カラムを先頭に戻す
' 行内ループ
Do While intCol <= g_cnsCOLCNT
ProgressBar1.Value = intIx
' 1セルずつ直接数値データを貼り付ける
.Cells(intRow, intCol).Value = intIx
' 次の値、列へ
intIx += 1
intCol += 1
Loop
Loop
End With
End Sub
'***********************************************************************************************
'* 処理名 :GP_SYORI_MODE2
'* 機能 :処理モード=2の処理
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 処理対象シート(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2009年06月21日
'* 作成者 :井上 治
'* 更新日 :2017年04月21日
'* 更新者 :井上 治
'* 機能説明:1行ずつ一次配列変数に格納してから1行(100列)単位にデータを貼り付ける
'* 注意事項: ⇒引数は処理対象ワークシート
'***********************************************************************************************
Private Sub GP_SYORI_MODE2(ByRef objSH As Excel.Worksheet)
'-------------------------------------------------------------------------------------------
Dim intIx As Integer = g_cnsIX_MIN ' テーブルINDEX
Dim intRow As Integer = 0 ' 行INDEX
Dim intCol As Integer ' カラムINDEX
Dim tblVal(g_cnsCOLCNT - 1) As Object ' 1行分のテーブル
With objSH
' 全体ループ
Do While intIx <= g_cnsIX_MAX
' 行単位処理
intRow += 1 ' 行を加算
intCol = 0 ' カラムを先頭に戻す
' 行内ループ
Do While intCol < g_cnsCOLCNT
ProgressBar1.Value = intIx
' 配列に値をセット
tblVal(intCol) = intIx
' 次の値、列へ
intIx += 1
intCol += 1
Loop
' 配列をセル範囲(1行分)にセット
.Range(.Cells(intRow, 1), .Cells(intRow, g_cnsCOLCNT)).Value = tblVal
Loop
End With
End Sub
'***********************************************************************************************
'* 処理名 :GP_SYORI_MODE3
'* 機能 :処理モード=3の処理
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 処理対象シート(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2009年06月21日
'* 作成者 :井上 治
'* 更新日 :2017年04月21日
'* 更新者 :井上 治
'* 機能説明:100列×1000行の二次配列にデータをセットしてから全体を一回で貼り付ける
'* 注意事項: ⇒引数は処理対象ワークシート
'***********************************************************************************************
Private Sub GP_SYORI_MODE3(ByRef objSH As Excel.Worksheet)
'-------------------------------------------------------------------------------------------
Dim intIx As Integer = g_cnsIX_MIN ' テーブルINDEX
Dim intRow As Integer = 0 ' 行INDEX
Dim intCol As Integer ' カラムINDEX
Dim tblVal((g_cnsIX_MAX / g_cnsCOLCNT) - 1, g_cnsCOLCNT - 1) As Object ' 2次元配列テーブル
' 全体ループ
Do While intIx <= g_cnsIX_MAX
' 行単位処理
intCol = 0 ' カラムを先頭に戻す
ProgressBar1.Value = intIx
' 行内ループ
Do While intCol < g_cnsCOLCNT
' 配列に値をセット
tblVal(intRow, intCol) = intIx
' 次の値、列へ
intIx += 1
intCol += 1
Loop
intRow += 1 ' 行を加算
Loop
ProgressBar1.Value = intIx - 1
With objSH
' 2次元配列をセル範囲(全体)にセット
.Range(.Cells(1, 1), .Cells(intRow, g_cnsCOLCNT)).Value = tblVal
End With
End Sub
'***********************************************************************************************
'* 処理名 :GP_SYORI_MODE4
'* 機能 :処理モード=4の処理
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 処理対象シート(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年04月16日
'* 作成者 :井上 治
'* 更新日 :2017年04月21日
'* 更新者 :井上 治
'* 機能説明:一旦JAG配列に格納してから二次元配列に変換させて全体を一回で貼り付ける
'* 注意事項: ⇒引数は処理対象ワークシート
'***********************************************************************************************
Private Sub GP_SYORI_MODE4(ByRef objSH As Excel.Worksheet)
'-------------------------------------------------------------------------------------------
Dim intColMax As Integer = g_cnsCOLCNT - 1 ' カラム方向最大INDEX
Dim intRowMax As Integer = (g_cnsIX_MAX / g_cnsCOLCNT) - 1 ' 行方向最大INDEX
Dim intIx As Integer = g_cnsIX_MIN ' テーブルINDEX
Dim intRow As Integer = -1 ' 行INDEX
Dim intCol As Integer ' カラムINDEX
Dim tblFld(intColMax) As Object ' 列方向テーブル
Dim tblRec() As Object ' 行方向テーブル
ReDim tblRec(intRow)
'-------------------------------------------------------------------------------------------
' 全体ループ
Do While intIx <= g_cnsIX_MAX
' 行単位処理
intCol = 0 ' カラムを先頭に戻す
ProgressBar1.Value = intIx
' 行内ループ
Do While intCol <= intColMax
' 列方向テーブルに値をセット
tblFld(intCol) = intIx
' 次の値、列へ
intIx += 1
intCol += 1
Loop
' 行方向を加算
intRow += 1 ' 行を加算
' 行方向テーブル(JAG配列)に格納
ReDim Preserve tblRec(intRow)
tblRec(intRow) = tblFld.Clone
Loop
ProgressBar1.Value = intIx - 1
'-------------------------------------------------------------------------------------------
Dim tblVal(intRowMax, intCol) As Object ' 2次元配列テーブル
intRow = 0
' JAG配列テーブルを二次元配列テーブルに置き換え
Do While intRow <= intRowMax
' 行単位処理
For intCol = 0 To intColMax
' 配列に値をセット
tblVal(intRow, intCol) = tblRec(intRow)(intCol)
Next intCol
' 次行へ
intRow += 1
Loop
'-------------------------------------------------------------------------------------------
' 2次元配列をセル範囲(全体)にセット
With objSH
.Range(.Cells(1, 1), .Cells(intRow, g_cnsCOLCNT)).Value = tblVal
End With
End Sub
'***********************************************************************************************
' ■■■ 呼び出しフォームとの受け渡しプロパティ ■■■
'***********************************************************************************************
' 処理モード(1=1セルずつ処理、2=1行ずつ処理、3=全体処理
'-----------------------------------------------------------------------------------------------
Friend WriteOnly Property prpSYORI_MODE() As Integer
Set(ByVal value As Integer)
g_intSYORI_MODE = value
End Set
End Property
'===============================================================================================
' 処理時間(TimeSpan)
'-----------------------------------------------------------------------------------------------
Friend ReadOnly Property prpSYORI_JIKAN() As TimeSpan
Get
prpSYORI_JIKAN = g_tspSYORI_JIKAN
End Get
End Property
'----------------------------------------<< End of Source >>------------------------------------
End Class
「処理フォーム」は開いた瞬間から処理を動かすので