タイトル | : Re^4: VBAでデータ貼り付け速度がちょう非常に遅い |
記事No | : 5801 |
投稿日 | : 2007/07/06(Fri) 20:53 |
投稿者 | : 通販の鬼 |
○花ちゃん さんへ
ソースサンプルを添付します。
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 'Excel出力ボタン:クリック時 '----------------------------------
''プロジェクト→参照の追加→COM→「Microsoft Excel 10.0 ObjectLibrary」(Ver10はOfficeXPです)を参照して下さい。
'================== 起動時の処理 =================== Dim l_xlsApp As New Excel.Application Dim l_xlsBooks As Excel.Workbooks = l_xlsApp.Workbooks '既存のファイルを開く場合 Dim l_xlsFilePath As String = "\原データリスト雛形.xls" Dim l_xlsBook As Excel.Workbook = l_xlsBooks.Open(My.Computer.FileSystem.CurrentDirectory & l_xlsFilePath) 'ファイルオープン Dim l_xlsSheets As Excel.Sheets = l_xlsBook.Worksheets Dim l_xlsSheet As Excel.Worksheet = l_xlsSheets.Item(1) 'シート1指定
l_xlsApp.DisplayAlerts = False 'アラート情報の非表示
'シート名変更 l_xlsSheet.Name = "テストシート"
'================== データの入力処理 ==================
'書式設定サンプル l_xlsSheet.Range("a1").Font.Color = RGB(255, 0, 0) 'フォントカラー l_xlsSheet.Range("a1").Interior.Color = RGB(255, 255, 0) '背景カラー
''''Excel出力速度低下はオブジェクトへのアクセス数に比例します。なるべく配列等でいっぺんに送るべし
'Excel転送用配列へデータ代入 'Dim l_aryExcelTransfer(39, 2) As Object Dim l_aryExcelTransfer(40000, 25) As Object
'For r As Integer = 0 To 39 'テストデータ作成 For r As Integer = 0 To 40000 'テストデータ作成 l_aryExcelTransfer(r, 0) = "ORD" & Format(r + 1, "0000") l_aryExcelTransfer(r, 1) = Rnd() * 1000 l_aryExcelTransfer(r, 2) = l_aryExcelTransfer(r, 1) * 0.07
l_aryExcelTransfer(r, 3) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 4) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 5) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 6) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 7) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 8) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 9) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 10) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 11) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 12) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 13) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 14) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 15) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 16) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 17) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 18) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 19) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 20) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 21) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 22) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 23) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 24) = l_aryExcelTransfer(r, 1) * 0.07 l_aryExcelTransfer(r, 25) = l_aryExcelTransfer(r, 1) * 0.07
Next '配列をExcelへ転送 'l_xlsSheet.Cells(7, 5).Resize(40, 3).Value = l_aryExcelTransfer '起点を指定し範囲内に配列を挿入 l_xlsSheet.Range("A1").Resize(40000, 26).Value = l_aryExcelTransfer 'l_xlsApp.Visible = True 'For l_cnt As Integer = 0 To 34000 Step 1000 'Next
'l_xlsSheet.Cells(7, 5).Resize(10000, 26).Value = l_aryExcelTransfer '起点を指定し範囲内に配列を挿入 'l_xlsSheet.Cells(10007, 5).Resize(1000, 26).Value = l_aryExcelTransfer '起点を指定し範囲内に配列を挿入 'l_xlsSheet.Cells(20007, 5).Resize(1000, 26).Value = l_aryExcelTransfer '起点を指定し範囲内に配列を挿入 'l_xlsSheet.Cells(30007, 5).Resize(1000, 26).Value = l_aryExcelTransfer '起点を指定し範囲内に配列を挿入 'l_xlsSheet.Cells(30007, 5).Resize(3000, 26).Value = l_aryExcelTransfer '起点を指定し範囲内に配列を挿入 'l_xlsSheet.Cells(7, 5).Resize(34001, 26).Value = l_aryExcelTransfer '起点を指定し範囲内に配列を挿入 'l_objSheet.Range("E7").Resize(40, 3).Value = DataArray '起点を指定し範囲内に配列を挿入
'l_objSheet.Cells(1, 1).Value = "Excel出力テスト" 'A1セルにデータを挿入する場合
'================== データの表示処理 ================== '雛形を新規ブックへコピー l_xlsSheet.Copy()
'雛形閉じる l_xlsBook.Close()
'表示 l_xlsApp.Visible = True
'================== 終了処理 ===================== MRComObject(l_xlsSheet) 'xlSheet の解放 MRComObject(l_xlsSheets) 'xlSheets の解放 'l_xlsBook.Close(False) 'xlBook を閉じる MRComObject(l_xlsBook) 'xlBook の解放 MRComObject(l_xlsBooks) 'xlBooks の解放 'l_xlsApp.Quit() 'Excelを閉じる MRComObject(l_xlsApp) 'xlApp を解放
End Sub
|