[[20180816200103]] 『データ集約ツールを作ろうとしてます。』(まい) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『データ集約ツールを作ろうとしてます。』(まい)

ボタンを押すと、別ブック1のシートのセルa1〜a9までの
データを開いているツール用のブックのシート2のa1〜a9にコピー貼り付け、次に別ブック2のシートa1〜a9をツール用のブックのシートb1〜b9に貼り付ける集約ツールを作りたいのですが、どのようにやればいいかわかりません。

sub ボタン1_click()
dim f1 as string, f2 as string

 f1 = range(E6).value

Workbook.open f1

というふうに、E6に記載されているパスを開いて貼り付けて行くというようにしたいです。

わかりにくい質問で申し訳ないです。

< 使用 Excel:Excel2010、使用 OS:Windows8 >


わからないところが解らないですが、提示の条件だと、
 (1)コピー元のブックを開く
 (2)貼付先のブックを開く?(もう開いてる?)
 (3)コピー元ブックの〇〇というシートの中にあるセル(範囲)をコピーして
 (4)貼付先ブックの〇〇というシートの中にある(単一)セルを基準にした範囲に貼り付ける。
ということになりますよね。

ファイルを探す方法がわからないのか、貼り付ける方法がわからないのか。。。
とりあえず、↓がヒントになるかもです。
[[20180809174451]]

(もこな2) 2018/08/16(木) 20:49


失礼。ブックとセル範囲は書いてありましたね。

何がわからないのかはわからないけど、足りない情報を、以下のように勝手に定義してサンプルコードを提供します。

 ・マクロが書いてあるブックの1番目のシートのE6に別ブック1と別ブック2が
  保存されているフォルダのパスがある
 ・コピー元のシート、貼付け先のシートもそれぞれのブックの1番目のシートとする。
 ・貼り付け先のシートはマクロを動かす前は空っぽである。

    Sub ボタン1_click()
        Dim MyPath As String
        Dim MyArr As Variant
        Dim tmp As Variant
        Dim srcWB As Workbook
        Dim dstRNG As Range

        MyPath = ThisWorkbook.Worksheets(1).Range("E6").Value
        MyArr = Array("別ブック1.xls", "別ブック2.xls")

        For Each tmp In MyArr

            With Workbooks("ツール用ブック.xls").Worksheets(1)
                Set dstRNG = .Cells(1, .Columns.Count).End(xlToLeft)
            End With

            With Workbooks.Open(MyPath & "\" & tmp)
                .Worksheets(1).Range("A1:A9").Copy dstRNG
                .Close
            End With

        Next tmp

    End Sub

(もこな2) 2018/08/17(金) 03:29


すみません。よく考えたら↑はダメダメですね。
↓に訂正で。

    Sub ボタン1_click()
        Dim MyPath As String, MyArr As Variant, i As Long

        Dim dstRNG As Range
        Set dstRNG = Workbooks("ツール用ブック.xls").Worksheets(1).Range("A1")

        MyPath = ThisWorkbook.Worksheets(1).Range("E6").Value
        MyArr = Array("別ブック1.xls", "別ブック2.xls")

        For i = 0 To UBound(MyArr)
            With Workbooks.Open(MyPath & "\" & MyArr(i))
                .Worksheets(1).Range("A1:A9").Copy dstRNG.Offset(0, i)
                .Close
            End With
        Next i
    End Sub

(もこな2) 2018/08/17(金) 06:58


回答ありがとうございます。

最初の質問を再度まとめて質問します。

1.集計用ブックのシート2のe6〜e7のセルに記載されているパスを開く(開くExcelブックの名前が毎回違うため関数で入っている)
2.e6のパスから開いたExcelブックのシート1のセルa1〜a9をコピーして、集計用ブックのシート1のa1〜a9に貼り付け、e6のパスで開いた、ブックを閉じる。
3.e7に記載されているパスを開き、開いたブックのシート1のセルa1〜a9をコピーして、集計用ブックのシート1のb1〜b9に貼り付けてe7のブックを閉じる。

という集計用ブックにボタン1つで、全部やってくれるツールを作りたいのですが、ブックを開くまでしか出来なかったです。
(まい) 2018/08/17(金) 12:24


>ブックを開くまでしか出来なかったです。

それを見せてください。

>e6のパスから開いたExcelブックのシート1のセルa1〜a9をコピーして、集計用ブックのシート1のa1〜a9に貼り付け、

「マクロの記録」を試してみてください。
で、どんなコードが記録されたか教えていただけますか。

(マナ) 2018/08/17(金) 19:38


ほぼほぼ答えを書いたと思いますが、ご覧頂いて応用することは難しかったでしょうか?
結果(結論?)だけ示すこともできますが、それだとご自身で応用しようと思ったときに困ってしまうと思いますので、もう少し頑張れるのであれば、とりあえず解決法の一例を示しますので、「ステップ実行」してみて、変数がどのような変化をしていくのか、どの部分でどのような命令を与えているのか研究してみてください。

    Sub ボタン1_click()
        Dim MyPath As String, MyArr As Variant, i As Long

        Dim dstWB As Workbook
        Set dstWB = Workbooks("集計用ブック.xls")

        Dim dstRNG As Range
        Set dstRNG = dstWB.Worksheets("シート1").Range("A1")

        Stop

        For i = 0 To 1
            MyPath = dstWB.Worksheets("シート2").cels(6 + i, "E").Value

            With Workbooks.Open(MyPath)
                .Worksheets(1).Range("A1:A9").Copy dstRNG.Offset(0, i)
                .Close
            End With
        Next i
    End Sub

また、短いコードにしようとおもったらこんな感じでよさそうに思います。

    Sub 改造案()
        Dim i As Long
        Dim dstRNG As Range

        Stop

        With Workbooks("集計用ブック.xls")
            Set dstRNG = .Worksheets("シート1").Range("A1")

            Do Until .Worksheets("シート2").Cells(6 + i, "E").Value = ""
                With Workbooks.Open(.Worksheets("シート2").Cells(6 + i, "E").Value)
                    .Worksheets(1).Range("A1:A9").Copy dstRNG.Offset(0, i)
                    .Close
                End With

                i = i + 1
            Loop
        End With
    End Sub

※なお、いずれもデータを用意してテストしているものではありませんので、ミス等ありましたらごめんなさい。
 (内容がわかれば修正方法もわかるはずと言い訳しておきます・・・)

(もこな2) 2018/08/17(金) 20:24


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.