[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ブック間のコピペ』(daddy)
お世話になります。
次のようなブック間の処理は可能でしょうか?
やりたいこと)
・ブック1のシート1に、複数のブックのシートからシート1にある
「同じ名前のデータのみ」を「D列以降の列」に順次コピペしていく
※ある列に1個でもデータがあれば、次シートのコピペは次列に移動
方法)
・コピペしたいシートの「名前」列と「データ」列(複数あり)を
選択後に「実行」ボタンを押す
※列は「オートフィルタ」状態の時もあります
※選択は「列全体」で行う予定です
・上記をシート毎に繰返す(順番は決まってません)
・ブック1のシート1は「開いた」状態とします
説明)
・シート1のA列に「名前」が入力済みです(通常1万行まで)
※重複や途中の空欄はありませんが「未ソート」です
・シート1の1行目は「タイトル」行とします
※タイトルは入力済みですが、コピペするデータとは無関係です
・シート1にコピペしたい列数は20列程度まで(複数ブック/シートで)
・コピペしたいシートにある「名前」は、シート1のとは一致しません
※過不足があります
※重複や途中の空欄はありませんが「未ソート」です
・データはいろいろな字種や空欄があります
多分、マクロになると思いますが、できるだけ「注釈」をつけて
いただけると助かります。(修業中の身です)
よろしくお願いします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
とりあえず、ブック間シート間の比較やコピーは簡単にできます(If文と代入だけ)ので、できるところはご自身で作成、
判らない箇所を質問していただく方が良いかと思います。
(???) 2014/10/27(月) 14:07
>コピー元は1ブック内に複数シート? →そうです。
>データは何行何列目? →ブック/シートによりいろいろです。
※1シート当りでは1万行まで、コピペしたい列は1列であったり、
複数列で連続もあれば“飛び飛び”もあります。
> 「名前」が一致しない場合はどうしたい? →何もしなくて構いません。
シート5とシート6をシート1にコピペする場合を例示します。
(操作はシート5→シート6の順とします)
・シート5 ア 10 イ 8 a ウ m ・シート6 イ * キ \ ア # ↓ ・シート1 キ \ サ イ 8 a *
>ブック間シート間の比較やコピーは簡単にできます(If文と代入だけ)ので、できるところは
ご自身で作成、判らない箇所を質問していただく方が良いかと(略)
→そうしたいのは“やまやま”です..胸中お察しください(涙)
よろしくお願いします。
追記)
コピー先のシート1へはコピペ順に列を追加していきます。
最終的に各列のデータはB列に「結合」予定です。
(daddy) 2014/10/27(月) 15:11
ここが非常に困るところ。
データの開始位置がA2だったりB5だったりするということ? せめてデータはA列2行目以降、というように、固定位置であって欲しいですが。
(開始位置可変ならば、どういう条件でどの位置になるのかを全部列挙してください)
行数はどうでもいいです。行数可変なのはExcelでは当たり前。
複数列も飛び飛びも、というのも少し疑問。そういう場合の例も挙げてください。
あと、名前の過不足、という表現も気になります。集計シートA列に「山」とあり、データには「山田」とか「小山」とあったとき、これは一致?不一致?
(???) 2014/10/27(月) 15:37
>複数列も飛び飛びも、というのも少し疑問。そういう場合の例も挙げてください。
→コピペしたいデータ列はシートにより異なります。(名前はA列共通です)
あるシートはA,F列のみ、別のシートはA,B,H,Q列、あるいはA,D〜G列(連続)など
>名前の過不足、という表現も気になります
→各シートで名前の種類・数が異なる..という意味です。
>集計シートA列に「山」とあり、データには「山田」とか「小山」..これは一致?不一致?
→「不一致」となります。
拙い説明ですが、各シートの“ワンクリック”(=「実行」ボタン)で次から次へとシート1に
同じ名前のデータを列単位でコピペしていく..というイメージです。
よろしくお願いします。
(daddy) 2014/10/27(月) 16:23
説明が必要そうな命令は使っていないので、変数説明だけ少し書いてます。
Sub test() Dim wkXLS As Workbook 'コピー元ブック Dim mySheet As Worksheet '出力先シート Dim cPath As String Dim cFile As String Dim i As Long 'コピー元シート数のループ Dim j As Long 'コピー元シート内行数のループ Dim k As Long '出力先「名前」のループ Dim kMax As Long '「名前」の定義数
Application.ScreenUpdating = False Application.ShowWindowsInTaskbar = False
Set mySheet = ActiveSheet cPath = "c:\test\" kMax = Cells(Rows.Count, "A").End(xlUp).Row
cFile = Dir(cPath & "*.xls*") While cFile <> "" Set wkXLS = Workbooks.Open(cPath & cFile, False, True) 'リードオンリーで開く For i = 1 To wkXLS.Sheets.Count With wkXLS.Sheets(i) For j = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row For k = 2 To kMax If mySheet.Cells(k, "A").Value = .Cells(j, "A").Value Then .Range(.Cells(j, "B"), .Cells(j, .Cells(j, .Columns.Count).End(xlToLeft).Column)).Copy _ mySheet.Cells(k, mySheet.Cells(k, mySheet.Columns.Count).End(xlToLeft).Column + 1) Exit For End If Next k Next j End With Next i wkXLS.Close cFile = Dir Wend
Application.ShowWindowsInTaskbar = True Application.ScreenUpdating = True End Sub (???) 2014/10/27(月) 16:38
簡単な例で試しましたが、シート1には何も表示されません。
以下の手順がオカシイのでしょうか?
・提示のマクロをシート1の標準モジュールにコピペ
・任意の別ブック/シートに「実行」ボタンを設定(提示マクロを登録)
・上記シートのA,B列に下記を入力し、「選択」後に「実行」ボタンを押す
名前
A 1
B 2
C 3
D 4
E 5
F 6
※シート1のA列は上記A列と同じにしてます
追記)2014/10/28/8:20
シート1にも「実行」ボタンを設定して試みましたが、同じでした。
(daddy) 2014/10/27(月) 21:58
再試行を繰返す中での疑問点をお尋ねします。
・提示マクロは、「test」フォルダーの中に「コピー元ブック」を
予め入れておく..で合ってますか?
・コピー元のシートにマクロ「実行」ボタンを設定しても、実行後にエラーになります
・「コピー先」に実行ボタンを設定するとコピー元シートの「コピーしたい列」が選択 できません
根本的にマクロを理解できてないようなので、使用方法を教えていただけませんか?
よろしくお願いします。
(daddy) 2014/10/28(火) 15:22
追記)17:15
試行とマクロの“読み解き”からの推測ですが、ご提示いただいたのは、
・シート1に「test」フォルダ内にある全てのブックのシート上にある
データをコピーする.. (シート1の「空欄」の扱いが??ですが)
というマクロではないでしょうか?
それであれば、こちらの希望とは違ってくるのですが..
(まちがっていたらご容赦ください)
今回の場合したいことは
元ブックで実行ボタンを押し
1 先ブックと名前を一致するデータを探す
2 一致した行のデータをアクティブされている列のみコピー
3 先ブックでD列に既にデータが入っていた場合次の列を参照ただし1行目のみデータが入っていてよい次の列を参照
4 データがない場合元データのデータをコピー
というようなマクロでよろしいでしょうか
修正):11:27
選択とありますが列を手動で選択するのですか?
選択するのならなぜ手動で選択するのか理由と何か条件がありましたらお書きください
(デイト) 2014/10/28(火) 18:40
どうしてもすべてのコピー元ブックにマクロを書きたい、というならば、コピー元と先を逆に考え、ご自分で直してみてください。
使い方はもう判ったかと思いますが、対象のファイルを1つのフォルダにまとめて置き、それを cPath に指定です。
ロジックは、元のA列と一致する場合、B列以降を先のB列以降にコピーしているだけです。
Columns.Count はExcelの列数の最大、Excel2010だと16384が得られます。
.Cells(j, .Columns.Count).End(xlToLeft).Column というのは、最終列からCTRL+←で移動した場合と同じ列、 つまりデータのある最後の列を求めています。 (???) 2014/10/29(水) 09:29
デイトさん
今回の場合したいことは、
>元ブックで実行ボタンを押し →そうです。
>1 先ブックと名前を一致するデータを探す →はい。
>2 一致した行のデータをアクティブされている列のみコピー →はい。
>3 先ブックでD列に既にデータが入っていた場合次の列を参照ただし1行目のみデータが入っていてよい次の列を参照
>4 データがない場合元データのデータをコピー
→はい。 補足しますと、先ブックシート列の「2行目以降」にデータがない場合はコピー「可」とします。
理由は、最初から列1行目にデータ(タイトル名)があるとは限らないためです。
先ブックはいわば“備忘録”のようなもので、とりあえず元ブックシートから都度必要なデータを
コピーしていきたいと考えています。
そうすると、いつの間にか予め入力したタイトル名(列1行目)以上のコピー列になってしまう可能性があります。
また、コピーは「列単位」です。 先にコピーした列セルが「空欄」でも、次列セルで“埋める”ことはしたくないです。
>選択とありますが列を手動で選択するのですか?
>選択するのならなぜ手動で選択するのか理由と何か条件がありましたらお書きください
→元ブックは複数あります。1ブックに複数シートがあり、コピーしたいデータはその中の一部の列です。
その列は、「列全体」の時もあれば「フィルタ」をかけなければならない時もあります。
よって、自ずと「選択」は「手動」にならざるを得ないと考えています。
したがって、操作としては(めんどうではありますが)以下を想定しています。
・元ブックシートのA列(名前)とコピーしたい列を「選択」(場合により事前にフィルタ)
・「実行」ボタンを押す
???さん
>ご要望ではコピー元にマクロを、との事でしたが、それだとコピー元全部にマクロを書かないといけなくなるので、
コピー先に書くマクロにしました..(割愛)
→承知いたしました。
希望は上述のとおりですが、提示いただいたマクロは他に応用できるブックがありますので、
活用させていただきたいと思います。
(daddy) 2014/10/29(水) 18:01
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim wkOut As Worksheet Dim i As Long Dim iMax As Long Dim R As Range
Set wkOut = Workbooks("ブック1.xlsx").Sheets("Sheet1") With wkOut iMax = .Cells(.Rows.Count, "A").End(xlUp).Row End With
For Each R In Target If R.Value <> "" And Rows(R.Row).Hidden = False Then For i = 2 To iMax If Cells(R.Row, "A").Value = wkOut.Cells(i, "A").Value Then wkOut.Cells(i, wkOut.Cells(i, wkOut.Columns.Count).End(xlToLeft).Column + 1).Value = R.Value Exit For End If Next i End If Next
Target(1).Select Cancel = True End Sub (???) 2014/10/30(木) 17:50
A 1 2 B 2 K 1 D 2 W 1 2 ↓ A 1 2 B 2 C D 2 E
既述しましたように、
>コピーは「列単位」で先にコピーした列セルが「空欄」でも、次列セルで“埋める”ことはしたくない<
...です。 上例であれば下表のようにしたいのですが。
A 1 2 B 2 C D 2 E
勝手いいますが、よろしくお願いします。
(daddy) 2014/11/05(水) 15:46
すべての行の、貼り付けた位置情報を保持すれば、空欄対応も可能ですが、処理速度が落ちますし、
私自身必要性を感じないので、時間を削ってまで変更対応する気はないです。
修行中の身と自覚されているのであれば、ここまでのコードがあれば、あとは一人で修正すべきと思います。
(???) 2014/11/05(水) 16:16
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim wkOut As Worksheet Dim i As Long Dim iMax As Long Dim R As Range
Set wkOut = Workbooks("ブック1.xlsx").Sheets("Sheet1") With wkOut iMax = .Cells(.Rows.Count, "A").End(xlUp).Row End With
For Each R In Target If Rows(R.Row).Hidden = False Then For i = 2 To iMax If Cells(R.Row, "A").Value = wkOut.Cells(i, "A").Value Then If R.Value = "" Then wkOut.Cells(i, wkOut.Cells(i, wkOut.Columns.Count).End(xlToLeft).Column + 1).Value = " " Else wkOut.Cells(i, wkOut.Cells(i, wkOut.Columns.Count).End(xlToLeft).Column + 1).Value = R.Value End If Exit For End If Next i End If Next
Target(1).Select Cancel = True End Sub (???) 2014/11/05(水) 16:22
>..空欄対応も可能ですが、処理速度が落ちますし(割愛)あとは一人で修正すべき..
→ごもっともなご意見だと思います。 “自力”をこころがけたいと思っているのですが..
>とりあえず、空欄を空欄のままコピーせず、スペース1文字にすることで、1列空ける例。
→試行ではうまくいきましたっ!
コピー先に予め空欄混在のデータがある場合などは、「スペース」を入れて対応するようにします。
これで作業を効率化できます。 ありがとうございました。
「右クリック」のみだと不安(自分にです..笑)なので、確認メッセージを追加するなど
していきたいと思います。
もちろん自力で行うつもりではありますが、SOSのときはどうかよろしくお願いします。
(daddy) 2014/11/06(木) 12:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.