VisualBasic VBでExcelのシート取り込み，読み込み
VisualBasicでExcelシートのデータを取り込みたいのですがネットを探しても自分が欲しいピンポイントのクラス，コードが見つからなかったため自作しました。自分用のマニアックな機能になっていますが参考になればと思いアップしました。
自作のクラスは下記のような機能があります。
シート番号またはシート名を指定して1つのシートから下記の3種の方法でデータを取り込み出来ます。
・全列，全行を取り込み
・列番号を指定して全行を取り込み
・列名を指定して全行を取り込み ※列名は1行目であること
バグがあるかも知れませんし思い通りの取り込みが出来ないかも知れません。自己責任でお願いします。
自作にあたり
VB.NETからExcelファイルのデータを読み込むには
の記事を参考にさせて頂きました。開いたExcelオブジェクトをチリも残さず「開放」させる手順を詳しく解説して頂いており大変参考になりました。
下手の横好きでプログラミングしており我流が染み付いています。バグ，見苦しい，助長，意味不明なコードとかあると思いますので遠慮せず指摘して頂ければ勉強になります。
参照設定のCOMから「Microsoft Excel XX.X Object Library」を選択。
-------------------------------------------------------------------
Imports System.IO
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Public Class ExcelImport
''' <summary>
''' 読み込むExcelファイルのフォルダー名,末尾「\」,例 D:\Data\
''' </summary>
''' <value>フォルダー名</value>
''' <returns>フォルダー名</returns>
''' <remarks></remarks>
Public Property excelFolderName() As String
''' <summary>
''' 読み込むExcelファイル名,例 ABCDEF.xls
''' </summary>
''' <value>Excelファイル名</value>
''' <returns>Excelファイル名</returns>
''' <remarks></remarks>
Public Property excelFileName() As String
''' <summary>
''' エラーNo,0=OK,1=NG
''' </summary>
''' <value>数値</value>
''' <returns>数値</returns>
''' <remarks></remarks>
Public Property errNo() As Integer
''' <summary>
''' エラー内容
''' </summary>
''' <value>文字列</value>
''' <returns>文字列</returns>
''' <remarks></remarks>
Public Property errMes() As String
Public Sub New()
_excelFolderName = "D:\Data\"
_excelFileName = "ABCDEF.xls"
_errNo = 0
_errMes = ""
End Sub
''' <summary>
''' Excelファイルから取り込み
''' </summary>
''' <param name="sheetSelect">
''' 0=シート名指定,1以上の数値はシート番号</param>
''' <param name="sheetName">読み込むシート名</param>
''' <param name="colSelect">
''' 0=全列読み込み,1=列番号指定,2=列名指定</param>
''' <param name="colName">1次元のString配列,列番号or列名</param>
''' <returns>2次元のオブジェクト配列</returns>
''' <remarks>列名はシートの1行目に記載されていることが条件</remarks>
Public Function excelImport(sheetSelect As Integer, _
sheetName As String, _
colSelect As Integer, _
colName() As String) _
As
Object(,)
Dim excelApp As Excel.Application = Nothing
Dim wkbk As Excel.Workbook = Nothing
Dim wkbks As Excel.Workbooks = Nothing
Dim sheets As Excel.Sheets = Nothing
Dim wksheet As Excel.Worksheet = Nothing
Dim crRange As Excel.Range = Nothing
Dim crMax As Excel.Range = Nothing
Dim colMax As Integer
Dim rowMax As Integer
Dim colNo As Integer
Dim rowNo As Integer
Dim dummyStr As String
excelImport = Nothing
Try
dummyStr = excelFolderName.Substring(excelFolderName.Length - 1, 1)
If dummyStr <> "\" Then
excelFolderName = excelFolderName & "\"
End If
If sheetSelect = 0 Then
If sheetName = Nothing OrElse sheetName = "" Then
Throw New Exception("シート名が指定されていない")
End If
End If
If colSelect > 2 Then
Throw New Exception("列選択番号が不適切" & vbCrLf & _
"2以下のところ" & colSelect)
End If
If colSelect = 1 Then
If colName Is Nothing OrElse Not IsNumeric(colName(0)) Then
Throw New Exception("指定列番号が不適切" & vbCrLf & _
"配列の中身無し or 最初が数値では無い")
End If
End If
If colSelect = 2 Then
If colName Is Nothing OrElse colName(0) = "" Then
Throw New Exception("指定列名が不適切" & vbCrLf & _
"配列の中身無し or 最初が空")
End If
End If
If Not File.Exists(excelFolderName & excelFileName) Then
Throw New Exception("Excelファイルが存在しない " & vbCrLf & _
excelFolderName & excelFileName)
End If
'Excelアプリケーションの開始
excelApp = New Excel.Application
wkbks = excelApp.Workbooks' ← 暗黙的変換を回避
'ファイルオープン
wkbk = excelApp.Workbooks.Open(excelFolderName & excelFileName)
sheets = wkbk.Worksheets
If sheets.Count < sheetSelect Then
Throw New Exception("指定したシート番号がシート数以上" & vbCrLf & _
sheets.Count & " 以下に対し " & sheetSelect)
End If
If sheetSelect = 0 Then
'指定シート名を検索し設定
For Each oSheet In sheets
If sheetName = oSheet.Name Then
wksheet = oSheet
End If
Next
If wksheet Is Nothing Then
Throw New Exception("指定したシート名が見つからない " & sheetName)
End If
Else
'シート番号で設定
wksheet = sheets(sheetSelect)
End If
'列,行の最大値を抽出
crMax=wksheet.Cells.SpecialCells(Excel.XlCellType.xlCellTypeLastCell)
colMax = crMax.Column
rowMax = crMax.Row
If colSelect = 1 Or colSelect = 2 Then
If colName.Length > colMax Then
Throw New Exception("指定列番号数が最大列数以上" & vbCrLf & _
colMax & " 以下に対し " & colName.Length)
End If
End If
Dim cells = wksheet.Cells
Dim tl = cells
Dim br = cells
'全桁のデータを抽出
If colSelect = 0 Then
tl = cells(1, 1)
br = cells(rowMax, colMax)
crRange = wksheet.Range(tl, br)
excelImport = crRange.Value
End If
'列番号を指定してデータを抽出
If colSelect = 1 Then
Dim dummyData(rowMax, colName.Length - 1) As Object
Dim colNo2 As Integer = -1
For colNo = 0 To colName.Length - 1
If Not IsNumeric(colName(colNo)) Then Continue For
If Integer.Parse(colName(colNo)) = 0 Then Continue For
If Integer.Parse(colName(colNo)) > colMax Then Continue For
colNo2 += 1
For rowNo = 1 To rowMax
tl = cells(rowNo, Integer.Parse(colName(colNo2)))
br = cells(rowNo, Integer.Parse(colName(colNo2)))
dummyData(rowNo - 1, colNo) = wksheet.Range(tl, br).Value
Next
Next
If colNo2 > -1 Then
excelImport = dummyData
Else
Throw New Exception("指定列番号無し")
End If
End If
'列名を指定してデータを抽出
If colSelect = 2 Then
Dim dummyData(rowMax, colName.Length - 1) As Object
Dim colNo2 As Integer = -1
Dim loop1 As Integer
For colNo = 0 To colName.Length - 1
If colName(colNo) = "" Then Continue For
For loop1 = 1 To colMax
tl = cells(1, loop1)
br = cells(1, loop1)
If colName(colNo) = wksheet.Range(tl, br).Value Then
colNo2 += 1
For rowNo = 1 To rowMax
tl = cells(rowNo, loop1)
br = cells(rowNo, loop1)
dummyData(rowNo - 1, colNo2) = wksheet.Range(tl, br).Value
Next
Exit For
End If
Next
Next
If colNo2 > -1 Then
excelImport = dummyData
Else
Throw New Exception("指定列名無し")
End If
End If
Catch ex As Exception
errNo = 1
errMes = ex.Message
Finally
'解放（全ての解放を行うため、FinalReleaseComObjectを利用します）
If Not crRange Is Nothing Then
Marshal.FinalReleaseComObject(crRange)
crRange = Nothing
End If
If Not crMax Is Nothing Then
Marshal.FinalReleaseComObject(crMax)
crMax = Nothing
End If
If Not wksheet Is Nothing Then
Marshal.FinalReleaseComObject(wksheet)
wksheet = Nothing
End If
If Not sheets Is Nothing Then
Marshal.FinalReleaseComObject(sheets)
sheets = Nothing
End If
If Not wkbk Is Nothing Then
'元のExcelファイルは保存せず終了。
wkbk.Close(SaveChanges:=False)
Marshal.FinalReleaseComObject(wkbk)
wkbk = Nothing
End If
If Not wkbks Is Nothing Then
Marshal.FinalReleaseComObject(wkbks)
wkbks = Nothing
End If
If Not excelApp Is Nothing Then
excelApp.Quit()
Marshal.FinalReleaseComObject(excelApp)
excelApp = Nothing
End If
End Try
End Function
End Class
-------------------------------------------------------------------
検証用コード
Private Sub Button1_Click(sender As Object, e As EventArgs) _
Handles Button1.Click
Dim colName() As String = Nothing
Dim excelData(,) As Object
Dim errNo As Integer
Dim excelIn As New ExcelImport
excelIn.excelFolderName = "D:\Work\"
excelIn.excelFileName = "TEST.xlsx"
'シート番号を指定し全列,全行を取り込み
excelData = excelIn.excelImport(1, "", 0, colName)
errNo = excelIn.errNo
excelIn = Nothing
excelIn = New ExcelImport
excelIn.excelFolderName = "D:\Work\"
excelIn.excelFileName = "TEST.xlsx"
'シート名を指定し全列,全行を取り込み
excelData = excelIn.excelImport(0, "Sheet1", 0, colName)
errNo &= excelIn.errNo
excelIn = Nothing
excelIn = New ExcelImport
excelIn.excelFolderName = "D:\Work\"
excelIn.excelFileName = "TEST.xlsx"
'列番号を指定して取り込み
colName = {"1", "7", "22"}
excelData = excelIn.excelImport(0, "Sheet1", 1, colName)
errNo &= excelIn.errNo
excelIn = Nothing
excelIn = New ExcelImport
excelIn.excelFolderName = "D:\Work\"
excelIn.excelFileName = "TEST.xlsx"
'列名を指定して取り込み ※列名は1行目であること
colName = {"日付", "時間", "データA", "データB", "合計"}
excelData = excelIn.excelImport(1, "", 2, colName)
errNo &= excelIn.errNo
excelIn = Nothing
If errNo = 0 Then
MessageBox.Show("処理が終了しました。", _
"処理終了", _
MessageBoxButtons.OK)
Else
MessageBox.Show("エラーNo=" & errNo, _
"エラー", _
MessageBoxButtons.OK, _
MessageBoxIcon.Error)
End If
End Sub
| 固定リンク
| コメント (1)
| トラックバック (0)
最近のコメント