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


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

回答の条件
  • 1人2回まで
  • 登録:2008/11/10 12:33:10
  • 終了:2008/11/10 18:03:58

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/11/10 13:50:18

ポイント45pt

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

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


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

'----------------------------------------------------
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
id:sterna

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

2008/11/10 18:02:30

その他の回答(1件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/11/10 13:50:18ここでベストアンサー

ポイント45pt

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

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


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

'----------------------------------------------------
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
id:sterna

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

2008/11/10 18:02:30
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/11/10 15:12:32

ポイント45pt

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
id:sterna

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

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

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

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

2008/11/10 18:03:08
  • id:Mook
    回答できないので仕様の確認コメントだけですが、
    同じ列の項目があったときに、行のデータはどのようにするのですか。

    単純に2005年のデータの下に2006年のデータを持ってくればよいのですか?
  • id:sterna
    はい。年,月も列名に必要でしたね。
    ここは並び替えは容易ですので順番は問いません。単純に縦に積み重ねていただければと思います。
    したがって、データの例を次のように訂正します。

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

    あと拒否設定を10名以上に変えました。これでいけますか?
  • id:Mook
    修正です。
    wsB.Range("A2").Resize(lastRowB - 1, 1).Copy

    wsB.Range("A2").Resize(lastRowB - 1, 2).Copy
    のように、1から2にしてください。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません