[リストへもどる]
一括表示

投稿時間:2003/01/17(Fri) 11:35
投稿者名:新入生
Eメール:waves@pb3.so-net.ne.jp
URL :
タイトル:
EXCELの部分複写で別シートへ転写
EXCELシートが複数ある中から、あるExcelファイルを選択後
そのシート内にある部分(例 F12,F14,F21〜F30)をゲットし別シートへ書きこむ
この時、Fは固定ですが行が複数行あります。約150行
元シート→新規の別Excelファイルのシートへコピーしたいのです。
F12→F1
F14→F2
といった具合です。

教えてください!お願いします。

投稿時間:2003/01/17(Fri) 12:44
投稿者名:k.k
Eメール:
URL :
タイトル:
Re: EXCELの部分複写で別シートへ転写
VBで行いたいのかな?VBAではなく
VBでエクセルを扱う方法はここのページに載ってますのでそれを参照してください。
もう知っているとは思いますけどね。
エクセルのVBAマクロを使用して行うのでしたら、
コピーは下のようにすればできます。
    Sheets("元シート").Select
    Range("F12").Select
    Selection.Copy
    Sheets("新規シート").Select
    Range("F1").Select
    ActiveSheet.Paste
でFを固定して(列を固定)行いたいのでしたらRangeのところで
    Range("F" & Cnt).Select
とすれば、Cnt変数の値を変えればF列の各行を参照することができますよ。

投稿時間:2003/01/17(Fri) 16:03
投稿者名:新入生
Eメール:waves@pb3.so-net.ne.jp
URL :
タイトル:
Re^2: EXCELの部分複写で別シートへ転写
> VBで行いたいのかな?VBAではなく
> VBでエクセルを扱う方法はここのページに載ってますのでそれを参照してください。
> もう知っているとは思いますけどね。
> エクセルのVBAマクロを使用して行うのでしたら、
> コピーは下のようにすればできます。
>     Sheets("元シート").Select
>     Range("F12").Select
>     Selection.Copy
>     Sheets("新規シート").Select
>     Range("F1").Select
>     ActiveSheet.Paste
> でFを固定して(列を固定)行いたいのでしたらRangeのところで
>     Range("F" & Cnt).Select
> とすれば、Cnt変数の値を変えればF列の各行を参照することができますよ。

投稿時間:2003/01/17(Fri) 16:09
投稿者名:新入生
Eメール:waves@pb3.so-net.ne.jp
URL :
タイトル:
KKRe^2: EXCELの部分複写で別シートへ転写
KKさんへ

> VBで行いたいのかな?VBAではなく
そうです。VBを使ってEXCELシートを参照して、別のEXCELファイルのシートに書きこみしたいのです。

> VBでエクセルを扱う方法はここのページに載ってますのでそれを参照してください。
> もう知っているとは思いますけどね。
> エクセルのVBAマクロを使用して行うのでしたら、
> コピーは下のようにすればできます。
>     Sheets("元シート").Select
>     Range("F12").Select
>     Selection.Copy
>     Sheets("新規シート").Select
>     Range("F1").Select
>     ActiveSheet.Paste
> でFを固定して(列を固定)行いたいのでしたらRangeのところで
>     Range("F" & Cnt).Select
> とすれば、Cnt変数の値を変えればF列の各行を参照することができますよ。

早速やってみました。
やっぱりどこか変かな?
予め、ファイルの場所を指定する箇所(file1)を作っています。

Private Sub Command1_Click()
    Label2.Caption = File1.Path & "\" & File1.FileName
    Dim MyFile As String
    MyFile = Dir$("c:\TEMP\work1.xls")
    If Len(MyFile) > 1 Then
                                            'ファイルを削除する
        Kill "c:\TEMP\Work1.xls"
        File1.Path = MyPath
        File1.Refresh
    End If

    On Error Resume Next
    Dim xlApp   As Excel.Application
    Dim xlBook  As Excel.Workbook
    Dim xlSheet As Excel.Worksheet

    Set xlApp = Excel.Application

    Set xlBook = xlApp.Workbooks.Open(Label1.Caption)
    Set xlSheet = xlBook.Worksheets(1)
    xlApp.Visible = False                   'Excelを表示しない
    
    Dim X       As Integer
    For X = 0 To 40
        Sheets(1).Select
        Range((X * 2) + 37, 2).Select
        Range((X * 2) + 37, 3).Select
        Range((X * 2) + 37, 24).Select
        Range((X * 2) + 37, 25).Select
        Range((X * 2) + 37, 26).Select
        Range((X * 2) + 37, 27).Select
        Range((X * 2) + 37, 28).Select
        Range((X * 2) + 37, 29).Select
        Range((X * 2) + 37, 30).Select
        Range((X * 2) + 37, 31).Select
        Range((X * 2) + 37, 32).Select
        Range((X * 2) + 37, 33).Select
        Range((X * 2) + 38, 33).Select
        Range((X * 2) + 37, 34).Select
        Range((X * 2) + 38, 34).Select
        Range((X * 2) + 37, 35).Select
        Selection.Copy
        Sheets("新規シート").Select
        Range((X * 2) + 37, 2).Select
        Range((X * 2) + 37, 3).Select
        Range((X * 2) + 37, 24).Select
        Range((X * 2) + 37, 25).Select
        Range((X * 2) + 37, 26).Select
        Range((X * 2) + 37, 27).Select
        Range((X * 2) + 37, 28).Select
        Range((X * 2) + 37, 29).Select
        Range((X * 2) + 37, 30).Select
        Range((X * 2) + 37, 31).Select
        Range((X * 2) + 37, 32).Select
        Range((X * 2) + 37, 33).Select
        Range((X * 2) + 38, 33).Select
        Range((X * 2) + 37, 34).Select
        Range((X * 2) + 38, 34).Select
        Range((X * 2) + 37, 35).Select
        ActiveSheet.Paste
    Next X

    xlSheet.SaveAs "c:\TEMP\Work2.xls"
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub

と、こんな風に書いてます。

投稿時間:2003/01/17(Fri) 16:49
投稿者名:A221
Eメール:
URL :
タイトル:
Re: KKRe^2: EXCELの部分複写で別シートへ転写
>         Range((X * 2) + 37, 2).Select

Range()の引数は文字列です。Cells()のような数値渡しではありません。

SelectTmp = "B" & (X * 2) + 37 & ":C" & (X * 2) + 37 & ","
SelectTmp = SelectTmp & "X" & (X * 2) + 37 & ":AI" & (X * 2) + 37 & ","
SelectTmp = SelectTmp & "G" & (X * 2) + 38 & ":H" & ((X * 2) + 38

※まとめて複数範囲選択する場合。

また、Set xlSheet = xlBook.Worksheets(1)としたのだから、

With xlSheets
    .Range(SelectTmp).Select
End With

こんな感じになります。
暗黙的なEXCELオブジェクトの使用はいけません。
メモリリークの原因になります。

    xlsobj.application.Selection.Copy
    xlsobj.WorkSheets("新規シート").Select

    Range同様〜

    xlsobj.WorkSheets("新規シート").Paste

>     Next X

#参考ですが、同一サイズの範囲で開始点がずれるだけなら、Rangeで選択した後
#.Range(SelectTmp).Offset(Row, Col).Select でオフセットできます。

投稿時間:2003/01/17(Fri) 17:09
投稿者名:新入生
Eメール:waves@pb3.so-net.ne.jp
URL :
タイトル:
ありがとうございます。
わかりました。
ありがとうございます。
やってみます。