投稿日	： 2004/08/10(Tue) 12:06
投稿者	： uchi
ＵＲＬ	：
タイトル	： エクセルシートの１行ずつを別ブックにコピー

お世話になります。

エクセルVBAでの開発はありますが、VBでのオブジェクト操作は初めてです。
こちらのサイトのサンプルを参考にして、既存エクセルシートの内容を１行ずつ、
新規ブックのシートにコピーするプログラムを作成しました。
(シートコピーの方が早いですが、ここでは１行ずつのコピーとしています。)

[以下のプログラムをご参照下さい]
(1)実行結果は、DisplayAlert=Falseを入れているのにも関わらず、自動的に作成されたブックの
　　保存を確認するメッセージが表示されてしまいます。
　　また、作成された「結果.xls」をダブルクリックして開くと、コピー元シートの行数分の
　　エクセルファイルが作成されていて、それらも開いてしまいます。
(2)オブジェクト操作が初めてのため、For-Nextの中での文法エラー、
　　かつ、処理終了後にエクセルタスクを残さないように、試行錯誤して行き着いたのが
　　今のロジックです。
　　しかし、結果.xlsにデータがコピーされていないので、ロジックエラーがあるようです。
　　さらに処理時間は、エクセルVBAで実行するのに比べて、かなり遅いです。

上記(1)(2)の点について、下記のロジックでの不具合をご指摘ください。
お手数ですが、よろしくお願いします。

-----------------------------------------------------------------------------
Private Sub Command1_Click()
    'xlBook2の内容を１行ずつxlBook1にコピーする練習
    'テスト環境：Win2000(SP4) VB6(SP6) EXCEL2000

    Dim xlApp As Excel.Application
    Dim xlBook1 As Excel.Workbook, xlBook2 As Excel.Workbook
    Dim xlSheet1 As Excel.Worksheet, xlSheet2 As Excel.Worksheet
    
    Dim RowPos As Long　　　　'xlBook2のxlSheet2シートの最大行を保存
    Dim i As Long　　　　　　'For-Nextのカウンター
    
    Set xlApp = CreateObject("Excel.Application")
    '新規のブック
    Set xlBook1 = xlApp.Workbooks.Add
    Set xlSheet1 = xlBook1.Worksheets(1)
    '既存のブック(ReadOnlyで開く)
    Set xlBook2 = xlApp.Workbooks.Open("C:\データ.xls",,True)
    Set xlSheet2 = xlBook2.Worksheets("sheet1")
    
    xlApp.Visible = False　　　　　　　　　　　　
    xlApp.Application.ScreenUpdating = False　　'xlApp.ScreenUpdating = True?
    
    'xlBook2のsheet1シートの使用されている最大行を取得(A列のセルは必ずセットされている)
    RowPos = xlSheet2.Range("A65536").End(xlUp).Row  
    
    '１行ずつをコピー
    For i = 1 To RowPos
　　　xlApp.Application.CutCopyMode = False
　　　xlBook2.Activate
　　　xlSheet2.Activate
　　　xlSheet2.Rows(i & ":" & i).Select
　　　xlApp.Selection.Copy
　　　xlBook1.Activate
　　　xlSheet1.Activate
　　　xlSheet1.Range("A" & i).Select
　　　xlApp.ActiveSheet.Copy
    Next i
    
    'ファイルの保存と終了
    xlApp.Application.DisplayAlerts = False
    xlSheet1.SaveAs ("C:\結果.XLS")　　　　'xlBook1.SaveAS("...") ?
    xlBook2.Close (False)
    xlApp.Application.DisplayAlerts = True

    xlApp.Application.ScreenUpdating = True　　　'xlApp.ScreenUpdating = true ?
    xlApp.Application.Quit　　　　　　　'xlApp.Quit ?
    
    Set xlSheet1 = Nothing
    Set xlSheet2 = Nothing
    Set xlBook1 = Nothing
    Set xlBook2 = Nothing
    Set xlApp = Nothing
    
End Sub
-----------------------------------------------------------------------------

★ - エクセルシートの１行ずつを別ブックにコピ.. - uchi 08/10-12:06No.9989
• Re: エクセルシートの１行ずつを別ブックに.. - Renard 08/10-22:54 No.9996
  • Re^2: エクセルシートの１行ずつを別ブック.. - uchi 08/11-08:34 No.9997