- 題名: Excel取り込みのスピードを上げる
- 日時: 2008/06/18 14:59:26
- ID: 22298
- この記事の返信元:
- （なし）
- この記事への返信:
- [22299] Re[1]: Excel取り込みのスピードを上げる2008/06/18 15:15:26
- ツリーを表示
DOBON.NETプログラミング掲示板過去ログ
エラーチェック内容も書いておきます
取り込み時、もし同じ商品があった場合、それを呼び出して実棚数を足して
更新するとしています
Dim strMessage_ERR As String = ""
Dim str_Sql As String = ""
Dim str_Sql2 As String = ""
Dim strK As String = ""
Dim dsRow As DataRow
Dim intLen As Int32 = 0
Dim intPoint As Int32 = 0
Dim strCHECK_JITTANA As String = ""
Dim cdJITUTANA As Double = 0
READ_EXCEL_ERR = False
'商品ｺｰﾄﾞﾁｪｯｸ -->
If str_SYOHIN_CD <> "" Then 'A列が無ければ飛ばす
'商品ｺｰﾄﾞﾁｪｯｸ -->
If strMessage_ERR = "" Then
Call TBL.C_SYOHIN(sdr2, CInt(str_SYOHIN_CD))
If Not sdr2.Read Then
strMessage_ERR = "商品が存在しません"
End If
Call SQL_DataReader(sdr2, ActionModeEnum.UserClose)
End If
If strMessage_ERR = "" Then
str_Sql = _
"Select " & _
"* " & _
"From " & _
"T_TANAOROSI With ( NoLock ) " & _
"Where " & _
"SYOHIN_CD = " & CInt(str_SYOHIN_CD) & Space(1) & _
"And INPUT_KBN = 0 "
Call SQL_DataReader(sdr3, ActionModeEnum.UserOpen, str_Sql)
If sdr3.Read Then
strMessage_ERR = "マニュアル入力済みです"
End If
Call SQL_DataReader(sdr3, ActionModeEnum.UserClose)
End If
'商品ｺｰﾄﾞﾁｪｯｸ <--
'実棚数ﾁｪｯｸ -->
'型ﾁｪｯｸ
If strMessage_ERR = "" Then
If IsNumeric(strJITTANA) = False Then
strMessage_ERR = "実棚数 型が一致しません"
End If
End If
'桁数ﾁｪｯｸ
If strMessage_ERR = "" Then
intLen = Len(strJITTANA)
intPoint = strJITTANA.LastIndexOf(".") + 1
If intPoint <> 0 Then
strCHECK_JITTANA = CStr(MC.CUT_STRING(strJITTANA, intPoint + 1, intLen, ""))
If Len(strCHECK_JITTANA) > 1 Then
strMessage_ERR = "実棚数 桁数オーバーです"
End If
End If
End If
If strMessage_ERR = "" Then
strK = CStr(Math.Abs(CDbl(strJITTANA)))
If Math.Abs(CDbl(strJITTANA)) >= 1000000 Then
strMessage_ERR = "実棚数 桁数オーバーです"
End If
End If
'実棚数ﾁｪｯｸ <--
'エラー出力用
If strMessage_ERR <> "" Then
dsRow = dsRpt2.Tables(strTable2).NewRow
'商品コード
dsRow("SYOHIN_CD") = str_SYOHIN_CD
'品名
dsRow("SYOHIN_NM") = strSYOHIN_NM
'実棚数
dsRow("JITTANA") = strJITTANA
'原価
dsRow("GENKA") = strGENKA
'売価
dsRow("BAIKA") = strBAIKA
'合計
dsRow("GOKEI") = strGOKEI
'エラー内容
dsRow("ERR") = strMessage_ERR
dsRpt2.Tables(strTable2).Rows.Add(dsRow)
End If
'取込用
If strMessage_ERR = "" Then
If dsRpt.Tables(strTable).Select("SYOHIN_CD = '" & str_SYOHIN_CD & "'").Length = 0 Then '08.06.18 DEL
dsRow = dsRpt.Tables(strTable).NewRow
'商品コード
dsRow("SYOHIN_CD") = str_SYOHIN_CD
'実棚数
dsRow("JITTANA") = CDbl(strJITTANA)
dsRpt.Tables(strTable).Rows.Add(dsRow)
Else
dsRow = dsRpt.Tables(strTable).Select("SYOHIN_CD = '" & str_SYOHIN_CD & "'")(0)
cdJITUTANA = CDbl(dsRow("JITTANA"))
dsRow("JITTANA") = cdJITUTANA + CDbl(strJITTANA)
dsRow.AcceptChanges()
End If
End If
End If
分類:[.NET]
お世話になります WinXP、VB.NET2005、Excel2003と言う環境です 取り込み元のデータが5000件や6000件等多くなると取り込みに時間がかかったり接続エラーになったりするので、 どうにか取り込みスピードを早くしたいと思っています 以下が現在の内容です 途中にREAD_EXCEL_ERRとありますが、ここでは商品ｺｰﾄﾞの有無と実棚数の桁等を確認して、 OKならそれを取り込む為に取り込み用のテーブルに追加して、 エラーならエラーとして出力する為にそれ用のテーブルに追加する様な記述をしています Dim oleCn As New OleDb.OleDbConnection() Dim oleCm As New OleDb.OleDbCommand() Dim oleDa As New OleDb.OleDbDataAdapter() Dim dt As New DataTable() Dim strWork(1) As String Dim intRow As Integer = 0 Dim xlApp As New Excel.Application() Dim xlBooks As Excel.Workbooks = xlApp.Workbooks Dim xlBook As Excel.Workbook = xlBooks.Open(Me.txt_PATH.Text & ".xls") Dim xlSheets As Excel.Sheets = xlBook.Worksheets Dim xlSheet As Excel.Worksheet = CType(xlSheets.Item(1), Excel.Worksheet) strK = xlSheet.Name xlApp.DisplayAlerts = False xlSheet = Nothing xlSheets = Nothing xlBook.Close() xlBook = Nothing xlBooks.Close() xlBooks = Nothing xlApp.Quit() xlApp = Nothing 'エクセルの場所とエクセルファイルを指定(Me.txt_PATH.Textから) oleCn.ConnectionString = _ "Provider=Microsoft.Jet.OLEDB.4.0; " + _ "Data Source=" & Me.txt_PATH.Text & ".xls" & ";" + _ "Extended Properties=""Excel 8.0;HDR=YES;IMEX=1;""" oleCm.CommandText = "Select * From [" & strK & "$] " oleCm.Connection = oleCn oleCm.CommandText = "Select * from [Sheet1$] " oleDa.SelectCommand = oleCm Try oleDa.Fill(dt) Catch ex As Exception oleDa.Dispose() oleDa = Nothing oleCm.Dispose() End Try '列数をカウント 6列で無ければダメ intColumns = dt.Columns.Count If intColumns = 6 Then Do While intRow < dt.Rows.Count strWork(0) = dt.Rows(intRow).Item(0).ToString 'A 商品ｺｰﾄﾞ strWork(1) = dt.Rows(intRow).Item(1).ToString 'B 品名 strWork(2) = dt.Rows(intRow).Item(2).ToString 'C 実棚数 strWork(3) = dt.Rows(intRow).Item(3).ToString 'D 原価 strWork(4) = dt.Rows(intRow).Item(4).ToString 'E 売価 strWork(5) = dt.Rows(intRow).Item(5).ToString 'F 合計 'ｴﾗｰﾁｪｯｸ Call READ_EXCEL_ERR(strWork(0), strWork(1), strWork(2), strWork(3), strWork(4), strWork(5)) intRow += 1 '次の行へ Loop Else oleDa.Dispose() oleDa = Nothing oleCm.Dispose() Exit Function End If oleDa.Dispose() oleDa = Nothing oleCm.Dispose() よろしくお願いします