SSブログ

VB.NET で構造体配列の内容をExcelに一括編集する方法 [プログラミング]

CSV形式のテキストファイルやデータベースを読み込んでExcelのシートに編集する場合、1行(レコード)ずつ処理するのは効率が悪いので配列にすべての行(レコード)を読み込んで一括編集したいものだ。
しかし、行(レコード)を一括して配列に格納すると"Column()"の形式となるため、複数の行(レコード)を配列に格納するとなると"Row()"の各要素の中に"Column()"のメンバを持つ構造体配列になるのだが、配列を一括でExcelに編集するためには配列は"Array(,)"形式の二次元配列でなければならない。
と言うことで、構造体配列を二次元配列に変換してExcelに一括編集する方法を纏めてみた。

配列の変換を大まかに説明すると、以下のようになる。
1.構造体配列(行().列())を二段階配列(配列(行)(列))に変換する。
2.二段階配列(配列(行)(列))を二次元配列(配列(列,行))に変換する。(ExcelのWorksheetFunction(行列の入れ替え)を利用)
3.二次元配列(配列(列,行))を二次元配列(配列(行,列))に変換する。(ExcelのWorksheetFunction(行列の入れ替え)を利用)

ここまでできれば後は編集したいセル範囲をRengeオブジェクトに設定し、Value2プロパティに配列を設定するだけだ。


以下の例ではCSV形式のテキストファイルまたはデータベースを構造体配列に読み込む代わりに配列を作成し、上記の要領で変換した配列を新規作成したブックに編集している。

簡単にコードを説明しよう。

・Excelの起動とブックの新規作成
VB.NETでExcelを利用するには「プロジェクト→参照の追加 COMタブより"Microsoft Excel xx.x Object Library"を追加」を行い、コードに"Microsoft.Office.Interop"のインポートが必要となる。
1.Excel.Applicationオブジェクトのインスタンスを生成してExcelを起動する。このときVisibleプロパティにFalseを指定すると非表示で起動することができる。
2.Excel.ApplicationオブジェクトのWorkbooksオブジェクトを生成し新規ブックを作成する。
※VB.NETでExcelを操作する際にはCOMオブジェクトの参照カウントの解放を意識しなければいけない。COMオブジェクトを参照し終わったら参照カウントをデクリメントしておかないとアプリケーションが終了しても起動したExcelのプロセスが残ったままになる場合があるからだ。詳しくは「vb.net excel releasecomobject」で検索。
※なので、COMオブジェクトのインスタンスを随時作成して利用し終わったら解放するといった手順が必要。

・配列をExcelに一括編集
先ほども説明したが、構造体配列を段階を踏んで二次元配列に変換した後、二次元配列に相当するセル範囲のRangeオブジェクトに編集する。
1.構造体配列(pRow().objCol())を二段階配列(objArray1()())に変換するわけだが方法は至って簡単。"objArray1()"と宣言した一次元配列に構造体配列の"pRow().objCol"を設定するだけで良い。すると先の説明の通り「構造体配列(行().列())」が「二段階配列(配列(行)(列))」になる。
2.Excel.ApplicationオブジェクトのWorksheetFunctionオブジェクトを生成しTransposeメソッドを利用して「二段階配列(配列(行)(列))"objArray1()()"」を「二次元配列(配列(列,行))"objArray2(,)"」に変換する。
3.上記2で二次元配列にすることができたが「行、列」ではなく「列、行」となっているので再度Transposeメソッドを利用して「二次元配列(配列(列,行))"objArray2(,)"」を「二次元配列(配列(行,列))"objArray3(,)"」に変換する。
4.変換した二次元配列の一次元目の要素数(行数)と二次元目の要素数(列数)から編集対象のWorksheetオブジェクトのRangeオブジェクトを生成し、Value2プロパティに"objArray3"を設定する。今回は編集先のセルの書式設定はしていないが必要に応じて配列を設定する前にセルの書式設定を行っておくと良い。
※二段階配列を二次元配列に変換する際に一つだけ注意点がある。構造体配列の要素数が一つしかない場合は当然二段階配列の一段階目も一つしか要素がない。この状態でTransposeメソッドを利用して行列を入れ替えるとエラーが発生する。理由は「行1×列n」の行列を入れ替えると「行n×列1」になるため「行n」の一次元配列になってしまうからだ。これを回避するため構造体配列から二段階配列に変換した後で二段階配列に空の要素を追加している。この追加された空の要素は二次元配列に変換しても空(Nothing)のまま存在しているが、Rangeオブジェクトに編集した際にNothingの箇所は当然のことながら何も値が設定されない。

以下の例を実行するには、新規の「コンソールアプリケーション」を作成し、先に記述した通り"Microsoft Excel xx.x Object Library"(xx.xはお使いのExcelのバージョンによって異なる)の参照を追加した後、コードを"Module1"に貼り付けて実行すれば良い。
Excelが起動し新規ブックを作成した後、コンソールウインドウに編集対象の配列の内容が出力される。画面の指示に従い何かキーを押すとExcelの1シート目に「10行×4列」の配列の値が編集される。更に画面の指示に従い何かキーを押すと2シート目に「1行×4列」の配列の値が編集される。最後にメッセージボックスの内容を確認して「OK」ボタンを押下するとブックを保存せずにExcelが終了してアプリケーションも終了する。


------------------------------------------------------------

Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop

Module Module1

    '型宣言
    '行の要素
    Private Structure COL_ARRAY
        Dim objCol() As Object
    End Structure

    '変数宣言
    Private gobjExcel As Excel.Application
    Private gobjBook As Excel.Workbook
    Private gobjSheet() As Excel.Worksheet

    Private Declare Function GetConsoleWindow Lib _
            "kernel32" () As Integer
    Private Declare Function SetForegroundWindow Lib _
            "user32" Alias "SetForegroundWindow" _
            (ByVal hwnd As Integer) As Integer

    Sub Main()

        'Excelのインスタンスを生成してブックを新規作成
        Console.WriteLine("Excelを起動します...")
        Dim intHwnd As Integer = GetConsoleWindow
        If fncCreateExcelBook() = False Then
            MsgBox("Excelの起動に失敗しました。" & _
                   ControlChars.CrLf & _
                   "アプリケーションを終了します。", _
                   MsgBoxStyle.Exclamation)
            Exit Sub
        End If

        Try
            Call SetForegroundWindow(intHwnd)
            '配列の準備
            Console.WriteLine( _
                "配列(typRow1)を以下の通り作成します...")
            Dim typRow1(9) As COL_ARRAY
            For i As Integer = 0 To 9
                typRow1(i).objCol = {"文字列1-" & _
                                     (i + 1).ToString, _
                                     1 * (i + 1), _
                                     "文字列2-" & _
                                     (i + 1).ToString, _
                                     10 * (i + 1)}
                Console.WriteLine("typRow1(" & _
                    i.ToString & ") ... " & _
                    Join(typRow1(i).objCol, ","))
            Next i
            Console.WriteLine( _
                "配列(typRow2)を以下の通り作成します...")
            Dim typRow2(0) As COL_ARRAY
            typRow2(0).objCol = {"文字列1", 1, "文字列2", _
                                 10}
            Console.WriteLine("typRow2(0) ... " & _
                    Join(typRow2(0).objCol, ","))

            Console.WriteLine( _
                "配列(typRow1)をシートに編集します..." & _
                "何かキーを押してください...")
            Console.ReadKey(True)
            '配列1(typRow1)をExcelに編集
            If fncEditExcel(typRow1, 0) = False Then
                MsgBox("配列1(typRow1)のExcel編集に" & _
                       "失敗しました。" & _
                       ControlChars.CrLf & _
                       "アプリケーションを終了します。", _
                       MsgBoxStyle.Exclamation)
                Exit Try
            End If

            Console.WriteLine( _
                "配列(typRow2)をシートに編集します..." & _
                "何かキーを押してください...")
            Console.ReadKey(True)
            '配列2(typRow2)をExcelに編集
            If fncEditExcel(typRow2, 1) = False Then
                MsgBox("配列1(typRow2)のExcel編集に" & _
                       "失敗しました。" & _
                       ControlChars.CrLf & _
                       "アプリケーションを終了します。", _
                       MsgBoxStyle.Exclamation)
                Exit Try
            End If

            MsgBox("配列のExcel一括編集が完了しました。" & _
                   ControlChars.CrLf & _
                   "OKボタンを押下するとExcelを閉じて" & _
                   "アプリケーションを終了します。", _
                   MsgBoxStyle.Information)

        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Exclamation)

        Finally
            'ブックを閉じる(保存しない)
            If Not IsNothing(gobjBook) Then
                Call subBookClose()
                Call subMRComObject(CType(gobjBook, Object))
                gobjBook = Nothing
            End If
            'Excelを閉じる
            If Not IsNothing(gobjExcel) Then
                gobjExcel.Quit()
                Call subMRComObject(CType(gobjExcel, Object))
                gobjExcel = Nothing
            End If

        End Try

    End Sub

    Private Function fncCreateExcelBook() As Boolean
        '*************************
        'Excelのインスタンスを生成してブックを新規作成
        '*************************

        Dim blnReturn As Boolean

        Try
            'Excelのインスタンスを生成
            gobjExcel = New Excel.Application
            gobjExcel.Visible = True

            'Excelブックを新規作成
            Dim objBooks As Excel.Workbooks = _
                                        gobjExcel.Workbooks
            gobjBook = objBooks.Add

            'Booksオブジェクトを破棄
            Call subMRComObject(CType(objBooks, Object))
            objBooks = Nothing

            'シートの作成と削除
            ReDim gobjSheet(1)
            For Each objSh As Excel.Worksheet _
                              In gobjBook.Worksheets
                Select Case objSh.Name
                    Case "Sheet1"
                        objSh.Name = "配列(typRow1)"
                        gobjSheet(0) = DirectCast( _
                          gobjBook.Worksheets(objSh.Name), _
                          Excel.Worksheet)
                    Case "Sheet2"
                        objSh.Name = "配列(typRow2)"
                        gobjSheet(1) = DirectCast( _
                          gobjBook.Worksheets(objSh.Name), _
                          Excel.Worksheet)
                    Case Else : objSh.Delete()
                End Select
                Call subMRComObject(CType(objSh, Object))
            Next
            For i As Integer = 0 To gobjSheet.Length - 1
                If IsNothing(gobjSheet(i)) Then
                    'シートのインスタンスが設定されていない場合、ブックにシートを追加
                    gobjSheet(i) = DirectCast( _
                        gobjBook.Worksheets.Add( _
                        After:=gobjBook.Worksheets.Count), _
                        Excel.Worksheet)
                    gobjSheet(i).Name = _
                        "配列(typRow" & i + 1 & ")"
                End If
            Next i

            blnReturn = True

        Catch comex As COMException
            MsgBox(comex.Message, MsgBoxStyle.Exclamation)
            blnReturn = False

        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Exclamation)
            blnReturn = False

        Finally
            If blnReturn = False Then
                If Not IsNothing(gobjBook) Then
                    Call subBookClose()
                    Call subMRComObject(CType(gobjBook, Object))
                    gobjBook = Nothing
                End If
                If Not IsNothing(gobjExcel) Then
                    gobjExcel.Quit()
                    Call subMRComObject(CType(gobjExcel, Object))
                    gobjExcel = Nothing
                End If
            End If

        End Try

        Return blnReturn

    End Function

    Private Function fncEditExcel( _
                     ByRef pRow() As COL_ARRAY, _
                     ByVal pIndex As Integer) As Boolean
        '*************************
        '配列をExcel編集可能な二次元配列に変換して編集
        '
        '   pRow()  :  変換対象の配列
        '   pIndex  :  編集対象シートの配列番号
        '
        '   Return  :  True:正常、False:異常
        '
        '*************************

        Dim blnReturn As Boolean
        Dim objCells As Excel.Range = _
               DirectCast(gobjSheet(pIndex).Cells, _
               Excel.Range)

        Try
            '配列を二段階配列に変換
            'pRow().objCol()→objArray1()()に変換する
            Dim objArray1(0) As Object
            For i As Integer = 0 To pRow.Length - 1
                If Not IsNothing( _
                    objArray1(objArray1.Length - 1)) Then
                    ReDim Preserve _
                          objArray1(objArray1.Length)
                End If
                objArray1(objArray1.Length - 1) = _
                                        pRow(i).objCol
            Next i

            If objArray1.Length = 1 Then
                '二段階配列の要素数が1の場合、二段階配列にダミー要素を追加
                '※ 要素数1の場合、行列の入れ替えで配列の次元数が減少することの対策
                '※ 追加したダミーの配列はNothingのため、Excelに編集する際に無視される
                Dim objDummy(pRow(0).objCol.Length - 1) _
                                        As Object
                ReDim Preserve objArray1(objArray1.Length)
                objArray1(objArray1.Length - 1) = objDummy
            End If

            '二段階配列の行列を入れ替えて二次元配列に変換
            'objArray1(R)(C)→objArray2(C,R)に変換
            Dim objFunc As Excel.WorksheetFunction = _
                DirectCast(gobjExcel.WorksheetFunction, _
                           Excel.WorksheetFunction)
            Dim objArray2(,) As Object = _
                CType(objFunc.Transpose(objArray1), _
                      Object(,))

            '変換した二次元配列の行列を再度入れ替えて行列を元に戻す
            'objArray2(C,R)→objArray3(R,C)に変換
            Dim objArray3(,) As Object = _
                CType(objFunc.Transpose(objArray2), _
                      Object(,))

            'WorksheetFunctionオブジェクトを破棄
            Call subMRComObject(CType(objFunc, Object))
            objFunc = Nothing

            gobjSheet(pIndex).Activate()
            '配列を編集するセル範囲を設定
            Dim objRange As Excel.Range = DirectCast( _
                    objCells.Range(objCells.Item(1, 1), _
                    objCells.Item(objArray3.GetLength(0), _
                    objArray3.GetLength(1))), Excel.Range)
            '配列を編集
            objRange.Value2 = objArray3

            'Rangeオブジェクトを破棄
            Call subMRComObject(CType(objRange, Object))
            objRange = Nothing

            blnReturn = True

        Catch comex As COMException
            MsgBox(comex.Message, MsgBoxStyle.Exclamation)
            blnReturn = False

        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Exclamation)
            blnReturn = False

        Finally
            'Cellsオブジェクトを破棄
            Call subMRComObject(CType(objCells, Object))
            objCells = Nothing

        End Try

        Return blnReturn

    End Function

    Private Sub subBookClose()
        '*************************
        'ブックを閉じる
        '*************************

        Try
            gobjBook.Close(False)

        Catch ex As Exception

        End Try

    End Sub

    Private Sub subMRComObject(ByRef pObject As Object)
        '*************************
        'COMオブジェクトの参照カウントを解放
        '
        '   pObject :  参照を破棄するオブジェクトのインスタンス
        '
        '*************************

        If Not IsNothing(pObject) Then
            Marshal.ReleaseComObject(pObject)
        End If

    End Sub

End Module

------------------------------------------------------------


タグ:VB.NET
nice!(0)  コメント(2)  トラックバック(0) 

nice! 0

コメント 2

通りすがり

こんにちは、有用な情報をありがとうございます。
まさに探していた情報なのですが、私の環境ではデバッグ時に「HRESULTからの例外 0x800A03EC」が発生してしまいます、原因を調査しましたが、よく解りませんでした。環境はVisual Studio 2019でOffice365です、何か分かる事がありましたらご教授頂けると幸いです。
by 通りすがり (2021-11-16 10:25) 

通りすがり

コメ1の者ですが、原因は解りませんが、その後「シートの作成と削除」のところで「ReDim gobjSheet(1)」とシートの箱を作成されていますが、2番目の要素には何も挿入されずNothingのままと判明し、1番目の要素のみに箱の大きさを変えて実行してみたところ、動作しました。一先ず色々と触らせていただきます、ありがとうございました。
by 通りすがり (2021-11-16 10:41) 

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。