社内システムの自作なら、すず工房へ!!
エクセル仕事術などでIT経営を支援します
  • Home
  • エクセル仕事術
  • クラウド生産管理
  • サービス案内
  • つぶやきました
  • お問合せ
  • すず工房
  • 名刺

別のワークブックのデータを読み込む

 2011年9月16日

あのブックのあのシートに、たしかデータを入れたはず、 顧客名や住所はすでに作成してある住所録から読み込んで入力したい、など、 すでに入力したデータを再利用したい場面は結構ありますよね。

そのために、ブックを開いて、データを表示させて、セルをコピーして、こっちのブックに戻ってセルに貼り付けて‥なんてやってられない。

ボタン一発でできないものか?

そんな悩みに答えるマクロを考えてみましょう。ボタン一発はムリですが、極力手入力をしないように、マウスクリックだけで、ならできます。

マクロプログラムの手順は以下のようにしました。

1.対象のワークブックを開く →[操作]: すでに開いているブックまたは開くブックを選択

2.[操作]:ブック内のシートを選択

3.[操作]:データを選択してマウスの右ボタンをクリック

4.選択範囲をコピー

5.元のブックのカレントセルに貼付け

6.ワークブックを閉じる  

 

操作はマウスクリックだけ。

ポイントは、別のワークブックのイベントを取得して、データをコピーすることです。

ここではマクロが設定されているワークブックから、データコピー元のワークブックでのマウスの右クリックを検出して、選択範囲のコピー・貼付けを実行しています。

 

詳しくはソースコードをご覧ください。  

*****標準モジュール*****

 

Option Explicit

Public wbkTrgt As Variant

Public whtTrgt As Variant

Public actWbk As Variant

Public actWht As Variant

Public actCell As Variant

 

Public Sub getData()

    '*****他のワークブックからデータを読み込む*****   

    Dim res As Variant

    Dim tmp As Variant

    Dim idx As Long

    

    Dim wbkPath As Variant

    Dim wbk As Workbook

    Dim wbkOpened As Variant

    

    Dim wht As Worksheet

    Dim whts As Variant

    

    Dim usedcell As Range

    wbkTrgt = ""

    whtTrgt = ""

    

    'カレントセルの情報を退避

    actWbk = ThisWorkbook.Name

    actWht = ThisWorkbook.ActiveSheet.Name

    ThisWorkbook.Activate

    ThisWorkbook.Worksheets(actWht).Select

    actCell = ActiveCell.Address

    

    'イベントを無効にする

    Application.EnableEvents = False

    '1.ワークブックを開く すでに開いているブック/ブックを選択

    'すでに開いているワークブックを探す

    ReDim wbkOpened(0 To 0)

    idx = -1

    For Each wbk In Workbooks

        If wbk.Name <> ThisWorkbook.Name Then

            idx = idx + 1

            If idx > UBound(wbkOpened) Then

                ReDim Preserve wbkOpened(0 To idx)

            End If

            wbkOpened(idx) = wbk.Name

        End If

    Next

    If idx > -1 Then

        'このブック以外に開いていたら、選択リストを表示する

        tmp = ""

        For idx = 0 To UBound(wbkOpened)

            tmp = tmp & idx + 1 & ": " & wbkOpened(idx) & vbCrLf

        Next idx

        tmp = tmp & "番号で入力してください‥"

        res = InputBox("すでに開いているワークブックから読み込みますか?" & vbCrLf _

                    & tmp, "ワークブック選択", "")

        If res <> "" Then

            '選択したワークブックをセット

            wbkTrgt = Workbooks(wbkOpened(res - 1)).Name

        End If

    End If

    If wbkTrgt = "" Then

        '選択しなかったらファイルを探す

        wbkPath = Application.GetOpenFilename( _

                        FileFilter:="Excelファイル (*.xls), *.xls,(*.xlsx),*.xlsx", _

                        Title:="開きたいファイルを選択してください", MultiSelect:=False)

        If wbkPath <> False And wbkPath <> "" Then

            '選択したfileをセット

            Workbooks.Open Filename:=wbkPath, ReadOnly:=True

            wbkTrgt = ActiveWorkbook.Name

        End If

    End If

    If wbkTrgt <> "" Then

        '2.ブック内のシートを選択

        ReDim whts(0 To 0)

        idx = -1

        For Each wht In Workbooks(wbkTrgt).Worksheets

            Set usedcell = wht.Cells.SpecialCells(xlCellTypeLastCell)

            'シートの中で使用済の範囲の右下のセル

            ' → 使用後にデータを削除しても、初期化されないことがあるが、

            ' → シートの中にデータがあるかどうかのいちおうの目安として使用する

            If Not (usedcell Is Nothing) Then

                idx = idx + 1

                If idx > UBound(whts) Then

                    ReDim Preserve whts(0 To idx)

                End If

                whts(idx) = wht.Name

            End If

        Next

        Set usedcell = Nothing

         If idx > -1 Then

            tmp = ""

            For idx = 0 To UBound(whts)

                tmp = tmp & idx + 1 & ": " & whts(idx) & vbCrLf

            Next idx

            tmp = tmp & "番号で入力してください‥"

            res = InputBox("シートを選択してください‥" & vbCrLf _

                        & tmp, "シート選択", "")

            If res <> "" Then

                whtTrgt = whts(res - 1)

                 Workbooks(wbkTrgt).Worksheets(whtTrgt).Activate

                  MsgBox "シート上でコピーしたいセルを選択して、" & vbCrLf _

                     & "マウスの右ボタンでクリックしてください。" & vbCrLf _

                     & "現在のシートのセルに貼付けできます。", vbOKOnly, "シート選択"

             End If

        Else

            MsgBox "このブックは空のようです‥", vbOKOnly + vbInformation

        End If

    End If

    

    'イベントを有効にする

   Application.EnableEvents = True

 End Sub

 ***** ThisWorkbook *****

 Option Explicit

'すべてのブックのイベントを取得するオブジェクトを宣言

' → 宣言すると、myExcel の下記のイベントが使えるようになる

Private WithEvents myExcel As Application

 

Private Sub myExcel_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    'すべてのブックの、右クリックイベントプロシージャ

    '3.データを選択 行全体/列全体/単独セル

    '4.コピー

    '5.貼付け  カレントセル/セル選択

    

    If Sh.Parent.Name = wbkTrgt And Sh.Name = whtTrgt Then

        '選択範囲をカレントセルに貼り付ける 値のみ

        

        If MsgBox("選択範囲をカレントセルに貼り付けます。" & vbCrLf _

            & "元には戻せません。" & vbCrLf _

            & "続けますか?", vbYesNo + vbQuestion, "貼付け確認") = vbYes Then

        

            Selection.Copy

            Workbooks(actWbk).Worksheets(actWht).Range(actCell).PasteSpecial _

                Paste:=xlPasteValues

            Application.CutCopyMode = False

        

    

            '6.ワークブックを閉じる

            If wbkTrgt <> "" Then

                If MsgBox("コピーしました。" & vbCrLf _

                        & vbCrLf _

                        & "読み込んだワークブック:" & wbkTrgt & vbCrLf _

                        & "を閉じますか?", vbYesNo + vbQuestion) = vbYes Then

                    Workbooks(wbkTrgt).Close savechanges:=False

                End If

            End If

            

        End If

        

        'Excelの右クリックメニュをキャンセル

        Cancel = True

    End If

        

End Sub

 

Private Sub myExcel_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    '選択したシート名とセルアドレスを表示

    Application.StatusBar = Sh.Name & " - " & Target.Address

End Sub

 

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    'ブックを閉じる前にオブジェクトを開放

    Set myExcel = Nothing

End Sub

 

Private Sub Workbook_Open()

    'ブックが開いたらオブジェクトを取得

    Set myExcel = Application

End Sub

以上。

  • 仕事に生かすExcel
  • マクロ・VBA
    • Excel2013のSDIへの対応
    • WEBからデータをVBAで取込む
    • 選択したセル範囲を取出すには
    • 消費税率を読込むDLL
    • インターネット上のサイトのデータを読み込む
    • 右ボタンでのMouseDownイベントには要注意
    • CSVファイルを読みこむ(Excel)
    • テキストファイル読込速度比較
    • 進行表示の3つの方法
    • IsDate関数はおかしい‥
    • 別のワークブックのデータを読み込む
    • 2 つの指定した日付の時間間隔と満年齢
    • ワークシートのセルに特定のデータを入力する
    • CSVファイルからデータを取り出す
    • ワークシートからデータを取得する
    • ワークシートにデータをセットする
    • 特定のセル範囲からデータを探す方法を比較する
  • Excelの操作

コンタクト

メール
メール
FaceBook
FaceBook

つぶやきました

見える生産管理2022

2022年 10月 31日 月

久しぶりの投稿になってしまいましたが、「見える生産管理2022」を試用できるようになりました。「クラウド生産管理」メニュからご覧ください。

0 コメント

Webデータベース利用の生産管理

2019年 7月 22日 月

いままでExcel(R)を活用した生産管理システムを構築したり構築支援したりしてきましたが、もっと簡単に生産管理を開始できないかと考え、Webに登場してきたデータベースを利用して生産管理できるシステムを考えました。

 

続きを読む 0 コメント

iPadのSIM

2018年 11月 16日 金

iPad Pro 12.9を外出時の仕事用に使っていたが、自宅のMACにリモートアクセスするのがベストに近いかもと気づき、4G回線経由だがやってみた。

しかしこれがかなり遅い。SIMは前の機種で使ってたイオンモバイルのやつ。これが原因かもと思い、一番早いと噂のUQ  Mobileに変えてみた。体感的にはちょっと早いかなという感じ。これからじっくり検証していこうと思う。

 

インターネット接続の設定でつまづいたので以下に備忘録として残しておく。

 

 

続きを読む
プライバシーポリシー | サイトマップ
Copyright © 2002- すず工房. All Rights Reserved.
ログアウト | 編集
  • Home
  • エクセル仕事術
    • 仕事に生かすExcel
      • Excelでできること
      • ExcelからSQLiteを使う理由
    • マクロ・VBA
      • Excel2013のSDIへの対応
      • WEBからデータをVBAで取込む
      • 選択したセル範囲を取出すには
      • 消費税率を読込むDLL
      • インターネット上のサイトのデータを読み込む
      • 右ボタンでのMouseDownイベントには要注意
      • CSVファイルを読みこむ(Excel)
      • テキストファイル読込速度比較
      • 進行表示の3つの方法
      • IsDate関数はおかしい‥
      • 別のワークブックのデータを読み込む
      • 2 つの指定した日付の時間間隔と満年齢
      • ワークシートのセルに特定のデータを入力する
      • CSVファイルからデータを取り出す
      • ワークシートからデータを取得する
      • ワークシートにデータをセットする
      • 特定のセル範囲からデータを探す方法を比較する
    • Excelの操作
      • ふりがなをつける
      • 行・列を固定してスクロール
      • 他のシートのデータを表示する-カメラ機能
      • 文章を指定範囲に収まるように整形する
  • クラウド生産管理
    • 見える生産管理2022
    • 見える生産管理K(簡易版)
    • 試用申込み
  • サービス案内
    • IT経営
  • つぶやきました
    • MAC
    • IT
    • その他
    • 年月別
      • 2022/10
      • 2019/07
      • 2016/07
      • 2016/04
      • 2015/11
      • 2015/10
      • 2015/08
      • 2015/07
      • 2015/06
      • 2015/03
      • 2015/02
      • 2014/12
      • 2014/03
      • 2013/09
      • 2012/11
      • 2012/09
      • 2010/09
      • 2010/08
      • 2010/07
      • 2010/06
      • 2010/03
      • 2010/02
      • 2009/05
      • 2009/04
  • お問合せ
  • すず工房
    • 企業理念
    • 主な資格
    • 実績
  • 名刺
  • トップへ戻る