こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

列コピーについて

VBAを利用した複数必要列をコピーする方法を教えて下さい。

シート1に入っているデータで
1行目には、項目名が入っています。
項目数はMAX200個前後です。

毎月各担当者からデータが入ったExcelブックを受け取り
必要な列だけを残して、データをコピペして頑張っていたのですが、
毎回列並びが異なるのと、担当者によっては抽出してくる
項目が違うため担当者ごとに修正するのが手まで困っております。

作業を以下の様にしたいです。

各ブックに入っている項目数はバラバラですが、最終的に必要な項目は
各担当者で必ず残してもらえています。
但し各担当者によって列並びがバラバラで困っています。


(1)例えばシート1に以下の様にデータを入力しておく (担当者で)
A B(列)
(行)
1 test
2 支店
3 営業担当者
4 番号

(2)シート2は各担当者より提出されるデータをまるっと貼り付ける
A B(列)
(行)test 日付 支店 営業担当者 エリア 番号 住所 電話番号
1
2 2行目以降はデータだけが入っている
3
4


★行いたいのは(2)に入っているデータより★
(1)に入力されているB列の2行目以降に入っている項目キーと一致するデータを
(2)からコピーしてシート3へ必要な項目が入っているデータを列ごと貼り付けたい

最終イメージーはにシート2に入っているデータから、
シート1には入っている項目だけのデータを
シート2からコピーしたデータだけがシート3に残るようにしたいです。
以下がシート3で最終的に残るデータとしたい
A(列)   B(列) C(列) D(列) E(列) F(列) → 以降項目数が続く
(行)test  支店   営業   担当者 番号    電話番号
1
2 2行目以降はデータだけが入っている
3
4
↓ 以降 データが入っている

必要データ以外は削除としたのですが、
項目数が多く以下の内容ではうまくいきませんでした。

※例として書いているのが項目名が4つとしていますが、
必要な項目数はおよそ30前後になります。下記の内容では、
文字数の関係でエラーが出た為必要な項目をコピーして別シートへ貼り付ける方が
よいとアドバイスをいただいたのですがうまく書けませんでした。

Dim rng As Range
Set rng = Cells.Find("test、支店、営業担当者、番号", , xlValues, xlWhole)
If Not rng Is Nothing Then
Range(rng.Offset.EntireColumn, rng.Address).Delete
End If
Set rng = Nothing


どのようにすれば必要な項目を列ごとコピーして別シートへ貼り付けることができるでしょうか。
是非お力添えをお願い致します。

投稿日時 - 2019-03-03 13:18:08

QNo.9593220

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.8

>仰る通り各担当者からのは添付データのようなイメージです。
ならば、
このイメージのシートが1枚目に無い
といったオチはありませんか?

マクロは、このイメージのシートが1枚目である必要があります。

投稿日時 - 2019-03-05 12:45:21

補足

遅くに申し訳ございません。
イメージシートは1枚目の認識です。
念の為に手順をお伺いしてもよろしいでしょうか。

投稿日時 - 2019-03-06 01:41:36

ANo.7

当方は、
編集元のエクセルファイルが添付のようなデータとイメージしています。
編集元のエクセルファイルがどのようなデータなのか教えてください。

列名が1行目に埋まっているんですよね?
途中に列名が空欄のセルがありますか?

投稿日時 - 2019-03-04 10:44:31

補足

ご連絡ありがとうございます。
残業で今帰宅し今確認しました。

仰る通り各担当者からのは添付データのようなイメージです。
新規ブックシート1のB列でもどこでもよいのですが、
縦に必要項目名を羅列します。

そしてシート2では、各担当者から受け取るデータを全部は率えます。
列の途中に空白などもありません。

最後に、シート1にある項目名だけが、シート2から列ごとコピーし
シート3などに貼り付け最終的に残ったデータはシート1と
項目名が一致したデータとなります。

投稿日時 - 2019-03-05 01:19:19

お礼

返答が遅くなり申し訳ございませんでした。

投稿日時 - 2019-03-05 01:19:37

ANo.6

>マクロでエラーが出て作業がストップ!

 えっ。で、試したら、こっちもエラーが出ました。で、これは、回避不能のエラーですね。で、対策は、ただ一つです。相手を変えることは不能。だったら、こっちが変わるだけですね。

現行:SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX")
対策:コピーの仕方にオプションを設ける。

   SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX", 0)
   SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX", 1)
   SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX", 2)

0:シートをクリアして書き込む。
1:既存シートの列の後に追加する。
2:既存シートの行の後に追加する。

 まあ、列の使用MAX、行の使用MAXが判れば、こんちのもんでしょうが・・・。

 まあ、VBAとしては3行ほどの追加になります。そして、書き込む位置を調節するXOffSet、YOffsetなる二つの変数をかますことになるでしょう。これしかないと思いますね。列名は、どこからどこまでは今でも指示できますので大丈夫です。

FROM [Sheet1$A1:A10]
FROM [Sheet1$A11:A20]
FROM [Sheet1$A21:A30]

で、マクロ1、2、3を順番通りに実行する。私の解決策は、こんな感じです。

投稿日時 - 2019-03-04 00:33:38

ANo.5

マクロブックは添付画像のように
必要な列名がB列の埋まっている前提です。
これにより
このマクロブックの2枚目に、
>シート2は各担当者より提出されるデータをまるっと貼り付ける
が作成され、
>シート2からコピーしたデータだけがシート3に
作成される動作になるはずなんです。

どこが期待と異なりますか?

投稿日時 - 2019-03-03 21:11:52

補足

回答ありがとうございます。
頂いた内容で行うと、列がありませんとなり、データが何も残らない状態となってしまいました。当方の力不足だと思います。

投稿日時 - 2019-03-03 22:56:11

ANo.4

【補足】SheetCopy()について

【利用方法】

[イミディエイト ウインドウ]
? SheetCopy("SELECT 抜き出したい列名リスト FROM [Sheet2$A1:Z10000]", "Sheet3")

 これだけです。

 なお、シート1のデータを参照して抜き出したいリストを自動生成するには

? SheetCopy("SELECT " & DSelsct("SELECT 列名 FROM [Sheet1$A1:A1000]",",") & " FROM [Sheet2$A1:Z10000]", "Sheet3")

と書きます。

 なお、SheetCopy()で重要な働きをするのは、DSelsct()です。この手の関数の冒頭の1行を見て、どういう引数を書くのかの理解に手間取るようでしたら、同関数の利用は勧めません。

Public Function DSelect(ByVal strSQL As String, _
            Optional colDelimita As String = ";", _
            Optional rowDelimita As String = "|", _
            Optional xlFileName As String = "", _
            Optional isHeader As Boolean = True) As String

 一応、質問者のやろうとしていることが1行のマクロで達成できる環境が整ったのご案内しておきます。なお、現状では、その1行をどのように書くべきかは示せません。質問に具体的な添付図が示されていない為です。

祈、成功!

投稿日時 - 2019-03-03 20:59:38

補足

正に頂いた内容にしたいのですが、うまくいかずです。

行いたいのが、

最終イメージーはシート1には入っている項目は
シート2で一致している項目のデータをだけを残し、
不要な列=シート1の項目にないデータは列ごと削除したい

項目数が約30前後のため1行マクロではどうすることもできなく、
行を「_」でと考えてもおかしな状態となるのです。

投稿日時 - 2019-03-03 22:49:03

ANo.3

先の質問に返信したマクロのを加工してポストします。
よかったら参考にしてみてください。
なお、
>(1)シート1のB列などにに項目名を縦にデータを入力し一覧にする。
シート1のB列1行目から縦に列名が期待の順番に並んでいる前提です.


Option Explicit

Sub Sample()

 Dim GetFilePath As String
 Dim GetBook As Workbook
 Dim GetSheet As Worksheet
 Dim TblSheet As Worksheet
 Dim PutSheet1 As Worksheet
 Dim PutSheet2 As Worksheet
 Dim RowCouter As Long
 Dim ColCouter As Long
 Dim ColNum As Long
 Dim ColName As String
 
 '編集元ブックを選択して開く
 With Application.FileDialog(msoFileDialogOpen)
  .InitialFileName = ThisWorkbook.Path
  .Show
  If .SelectedItems.Count = 0 Then
   MsgBox ("ファイルの選択がキャンセルされました。")
   Exit Sub
  End If
  GetFilePath = .SelectedItems(1)
 End With
 Set GetBook = Workbooks.Open(GetFilePath)
 Set GetSheet = GetBook.Sheets(1)
 Set TblSheet = ThisWorkbook.Sheets(1)
   
 '出力先シートを自ブックに追加し、編集元シートを複写
 ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(1)
 GetSheet.Copy after:=TblSheet
 Set PutSheet1 = ThisWorkbook.Sheets(2)
 Set PutSheet2 = ThisWorkbook.Sheets(3)
 
 RowCouter = 1  '列並び一覧のデータ開始行
 
 '列ごとにコピペ
 Do
  If TblSheet.Cells(RowCouter, 2).Value = "" Then Exit Do
  ColName = TblSheet.Cells(RowCouter, 2).Value 'B列を順に取得
  ColCouter = 1
  ColNum = 0
  Do
   If PutSheet1.Cells(1, ColCouter).Value = "" Then Exit Do
   If ColName = PutSheet1.Cells(1, ColCouter).Value Then
    ColNum = ColCouter
    Exit Do
   End If
   ColCouter = ColCouter + 1
  Loop
  If ColNum = 0 Then
   MsgBox ("列がありません:" & ColName)
  Else
   PutSheet1.Columns(ColNum).Copy
   PutSheet2.Columns(RowCouter).PasteSpecial
  End If
  RowCouter = RowCouter + 1
 Loop
 
 'Application.DisplayAlerts = False
 GetBook.Close False '編集元ブックをクローズ
 'Application.DisplayAlerts = True

End Sub

投稿日時 - 2019-03-03 15:26:40

補足

回答がありがとうございます。
頂いた内容だと、新規ExcelブックでVBAのデータを書いて実行すると、
データの入ったExcelブックを指定して開いて、コピーとなるようです。

また、説明が下手で申し訳ないです。
行いたい最終データのイメージですが、
A(列)   B(列) C(列) D(列) E(列) F(列) → 以降項目数が続く
(行)test  支店   営業   担当者 番号    電話番号
1
2   2行目以降はデータだけが入っている
3
4
↓ 以降 データが入っている

シート1にB列に縦に【残したいデータの項目が入る】
シート2が各担当者から受け取るデータが入っていて、
シート2で残るのが【シート1のB列に入っている項目名と一致したもの】ですが、

シート2の項目名は
A(列)   B(列) C(列) D(列) E(列) F(列)
※各列の【1行目に横の行】に展開されており、
 データは1行目以降の列に入っている
1↓ 以降 データが入っている
2↓ 以降 データが入っている
3↓ 以降 データが入っている

シート1のB列に縦に入っているデータを
シート2で項目が一致しているものだけを、【列ごとコピーしてシート3】に移す。
またはシート2でシート1に入っている【項目以外のデータをシート2から削除しシート1の項目と一致するものだけが残る】、というように実行したいのですがうまくいかず困っております。是非お知恵を貸して頂けると助かります。

投稿日時 - 2019-03-03 18:42:06

ANo.2

各担当者のシートデータをどうまとめようとしているのか伝わりにくい。
(成績的な=)量的な、集約表を作るのか。
列的に表の体裁(=列項目の出現)を統一したいのか。
データの列位置だけを内容的に全員分揃えるのか?
普通はA担当者のデータの行的最終行の次に、B担当者のデータを張り付ける、などでよい(ある商品の売上個数(や商品名)を累積していく)場合があると思うが、完成後A担当者のデータか、B担当者のデータかどうかは、残す必要があるのかな。
ーー
あるならどこかの列に氏名などを残せばよい。
ーー
例えば人事表などで
X氏 A,C、F項目を記入あり
Y氏 A、B、F項目を記入あり

ーは空白列として
X A ーC-ーF
Y AB-ーEー
のようなデータを作ればよいのか?
==
見出しの文字列は担当者は、1字1句間違わないという前提で
VBAでFindで標準の列を見つける。
累積するなら、その列について、END(xlUp)で直前までの最終行を見つけ
その直下から張り付ければ仕舞い。
 処理実行時間は多少かかっても、VBAのコード行数は少なくて済む簡単な問題。
質問文を読み解くのに苦労する。
3人分、3項目のシート模擬例で、シートデータの完成形を示すのが一番良いと思うよ。

投稿日時 - 2019-03-03 15:16:04

ANo.1

Q、必要な項目を別シートへコピーする方法。
A、10個ぐらい新しい私の質問を参照されたし。

 それは、質問者の希望を叶えるための仕上げの為の質問です。その添付図でも分かるように、項目を指定して、かつ、色んな条件を付けて別シートにコピーすることが可能です。ただ、A⇒H、B⇒Hを連続的に行うには、追加開始の行を指示できるように、また、見出し部の書き込みの要不要も指示できるように改変する必要があります。でも、そういう改変をしないで、Hは一時シートという位置付けをされた方が無難だと思います。

 明日までには、《緑の三角門田》は解決すると思います。で、その時は、関数一発でコピーも可能となります。イミディエイトウインドウで関数を起動するだけです。

 まあ、エクセルについては知識ゼロの私の回答。参考程度に読み流してください。

投稿日時 - 2019-03-03 13:57:14

あなたにオススメの質問