人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【異なる順番の列データの結合】Excelで列名が異なる順番や異なるものを含んだ状態で並んでいる2つのシートを、特定の順番で1つのシートにまとめたいと思います。Excel2003のほかにExcelのVBA、MSアクセス2003やOoo,R等のフリーソフトを使ってもよいですが、なるべくExcelのシートの状態から操作するにあたって、簡単な方法をお教えください。なお、実データは列数が多すぎてExcel上では行と列の入れ替えや、行名全部をLookup関数で検索するなどはできないものとします。

データの例:例えば毎月の柑橘類の値段のデータシートで・・・
2005年分のシート1の列(みかん,いよかん,甘夏); 2006年分のシート2の列(金柑,みかん,甘夏)
05-06年の2つのシートのデータをまとめて新たに作るシートの列(みかん,いよかん,甘夏,金柑)

●質問者: arakai
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:2005年 2006年 Excel MS OOo
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●45ポイント ベストアンサー

とりあえず回答可能になりましたので、簡単なサンプルです。

期待と異なる点があったら、コメントください。


コードの最初にあるシート名の定義を適切に変更して実行ください。

'----------------------------------------------------
Sub SheetMarge()
'----------------------------------------------------

  '- ★ 統合するシートの指定:実際のシート名にあわせる
 Dim wsA As Worksheet
 Set wsA = Worksheets("2005年")

 Dim wsB As Worksheet
 Set wsB = Worksheets("2006年")

  '---1行目のチェック
 If wsA.Range("A1").Value <> "年" _
 Or wsB.Range("B1").Value <> "月" _
 Or wsA.Range("A1").Value <> "年" _
 Or wsB.Range("B1").Value <> "月" Then
 MsgBox "シートの先頭列が日付ではありません"
 Exit Sub
 End If

  '---統合シートの作成
  '- ★ 同じシート名があるとエラーになるので、再作成する際は事前に削除する必要がある
 Dim dstWS As Worksheet
 wsA.Copy before:=Worksheets(1)
 Set dstWS = ActiveSheet
 dstWS.Name = wsA.Name & "_" & wsB.Name
 
 Dim lastColA As Long
 Dim lastColB As Long
 Dim lastRowA As Long
 Dim lastRowB As Long
 
 lastColA = wsA.Range("A1").End(xlToRight).Column
 lastColB = wsB.Range("A1").End(xlToRight).Column
 lastRowA = wsA.Range("A1").End(xlDown).Row
 lastRowB = wsB.Range("A1").End(xlDown).Row
 
 wsB.Range("A2").Resize(lastRowB - 1, 1).Copy Destination:=dstWS.Cells(lastRowA + 1, "A")
 
 Dim rngTitle As Range
 For i = 3 To lastColB
 Set rngTitle = wsA.Range("A1").Resize(1, lastColA).Find(what:=wsB.Cells(1, i).Value, lookat:=xlWhole)
 
 If rngTitle Is Nothing Then
 lastColA = lastColA + 1
 dstWS.Cells(1, lastColA).Value = wsB.Cells(1, i).Value
 wsB.Cells(2, i).Resize(lastRowB - 1, 1).Copy Destination:=dstWS.Cells(lastRowA + 1, lastColA)
 Else
 wsB.Cells(2, i).Resize(lastRowB - 1, 1).Copy Destination:=dstWS.Cells(lastRowA + 1, rngTitle.Column)
 End If
 Next
 
End Sub
◎質問者からの返答

ありがとうございます。年、月の挙動がうまくないですが、無事動きました。


2 ● SALINGER
●45ポイント

ExcelVBAになります。

実行するとシート1をコピーし「05-06年」という名前をつけて、

その下にシート2の内容をコピーして一つのシートとします。


Sub SheetMarge()
 Dim sh1 As Worksheet  '合計シート
 Dim sh2 As Worksheet  'シート2
 Dim lastRow1 As Long  '合計シート最終行
 Dim lastRow2 As Long  'シート2最終行
 Dim lastColumn1 As Long  '合計シート列
 Dim lastColumn2 As Long  'シート最終列
 Dim i As Long
 Dim j As Long
 Dim obj As Object
 
  '画面のちらつきを無くす
 Application.ScreenUpdating = False
 
  '実際のシート名などに合わせてください
 Worksheets("Sheet1").Copy before:=Worksheets("Sheet1")
 Set sh1 = ActiveSheet
 Set sh2 = Worksheets("Sheet2")
 sh1.Name = "05-06年"
 
 lastRow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
 lastRow2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
 lastColumn2 = sh2.Cells(1, Columns.Count).End(xlToLeft).Column
 
 For i = 1 To lastColumn2
 Set obj = sh1.Rows(1).Find(sh2.Cells(1, i).Value)
 If obj Is Nothing Then
 lastColumn1 = sh1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
 Else
 lastColumn1 = obj.Column
 End If
 sh1.Cells(1, lastColumn1).Value = sh2.Cells(1, i).Value
 
 For j = 2 To lastRow2
 sh1.Cells(lastRow1 + j - 1, lastColumn1).Value = sh2.Cells(j, i).Value
 Next j
 Next i
 
 Application.ScreenUpdating = True
End Sub
◎質問者からの返答

ありがとうございます。無事動きました。

2枚目のシートの列名を取って1枚目の列名から検索してマッチした行番号もしくはひとつ後にいれるという作業を繰り返すわけですね。

お二人とも大変迅速なご回答ありがとうございます。

お二人のを合わせて列名の順番など使い勝手を自分で改善していきたいと思います。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ