[ツリー表示へ] [ワード検索] [Home]
タイトル ： Re^4: VBAでデータ貼り付け速度がちょう非常に遅い 投稿日 ： 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 |
をクリックするとツリー全体を一括表示します） - VBAでデータ貼り付け速度がちょう非常に遅い - 通販の鬼 07/07/06-18:21No.5793