[[20161021192104]]　『統合で左から2列までの項目を固定』（匿名）　ページの最後に飛ぶ

『統合で左から2列までの項目を固定』（匿名）

シート毎に、A1に「商品コード」、B1に「商品名」、c1に「1月」「2月」「3月」←ここはシートごとに違う
A2～10に実際の商品コード、B2～10に実際の商品名、C2～10に実際の売上金額がある表があります。

表の1行目の項目以外の中身はレイアウトはバラバラです。
（商品があったりなかったり）

そこで、月別の商品別の合計金額を出すために統合させると、1行目の項目はもちろん表示されますが、
商品名の列（B列）の中身だけがすべて空白になっています。

要するに、左から2列の商品コードと商品名は固定にしたいのですが
どうやればできるのでしょうか。

説明下手ですみません。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

わかりにくくて申し訳ありません。

sheet1
　　A　　　　　　 B　　　　 C
1　商品コード　商品名　　1月

2　 1　　　　　本　　　　　2,000
3　 2　　　　　鉛筆　　　　500
4　 3　　　　　消しゴム　　800
5　 4　　　　　ハサミ　　　1,000

sheet2
　　A　　　　　　 B　　　　 C
1　商品コード　商品名　　2月

2　 2　　　　　鉛筆　　　　100
3　 3　　　　　消しゴム　　50
4　 4　　　　　ハサミ　　　80

↓

sheet3　統合用

　　A　　　　　　 B　　　　　C　　　D
1　商品コード　商品名　　1月　　2月

2　 1　　　　　　　　　　　 2,000
3　 2　　　　　　　　　　　 500　　　100
4　 3　　　　　　　　　　　 800　　　50
5　 4　　　　　　　　　　　 1,000　　80

とB列の値が空白になってしまいます。
商品名までも合計してしまっているのでしょうか。結果文字列のため合計できないから空白に？
A列とB列までを見出しにしたいのですが。
一番左端しか見出しにはできないのでしょうか。

　　　　　　　
　
（匿名） 2016/10/21(金) 20:25

商品コード一覧を、作成してvlookupで表示させてみては?
ダメでしょうか?
（通りすがり） 2016/10/21(金) 21:46

通りすがり様

ありがとうございます。VLOOKUPですか。
すみません、商品コード一覧を手早く作成する方法はありますでしょうか。
シートは12カ月分12枚あります。レコードは3000件くらいあります。
頭が固くて、私が思いつく方法は、シートすべての表を縦にコピペしていって（3000件×12シート）
重複したレコードをどうにかして削除するという方法しかおもいつかないのですが。

（匿名） 2016/10/21(金) 22:31

シート12枚を、まとめるのはマクロでやれば確実です。
そのまとめたものを商品コードで
カウントしてフィルターで1のものを抽出するかエクセルの機能で重複削除ってのがあったような?
（通りすがり） 2016/10/22(土) 06:35

http://www.ex-it-blog.com/sheetmerge-macro

↑ここが、参考になりそうですよ！！
（通りすがり） 2016/10/22(土) 08:34

通りすがり様

早速のご回答をありがとうございました。
マクロを使えば早いですね。このマクロは汎用性がありそうですし、意味を理解して作成してみます。
（匿名） 2016/10/22(土) 11:40

Sub myDic1()

    Dim myDic As Object, myKey As Variant
    Dim c As Variant, varData As Variant
        Set myDic = CreateObject("Scripting.Dictionary")
        With Worksheets("Sheet1")
            varData = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
        End With
        For Each c In varData
            If Not c = Empty Then
                If Not myDic.Exists(c) Then
                    myDic.Add c, Null
                End If
            End If
        Next
        myKey = myDic.Keys
        With Worksheets("Sheet2")
            .Range("G:G").ClearContents
            .Range("G1").Resize(myDic.Count) = Application.WorksheetFunction.Transpose(myKey)
        End With
        Set myDic = Nothing
 End Sub

重複を、取り除いてくれます！
（通りすがり） 2016/10/22(土) 19:02

マクロなら統合にこだわらなくてもよいのかもしれませんが
手軽で便利な機能なので、わたしはよく使います。

 　
こっち [[20161022121804]] の回答を応用してみました。

 Option Explicit

 Sub test()
    Dim dst As Range
    Dim ws As Worksheet
    Dim ary()
    Dim n As Long

    Set dst = Worksheets("統合用").Cells(1)
    dst.CurrentRegion.ClearContents

    For Each ws In Worksheets
        If ws.Name <> dst.Parent.Name Then
            n = n + 1
            ReDim Preserve ary(1 To n)
            ws.Columns(1).Insert
            With ws.Cells(1).CurrentRegion
                .Resize(, 1).FormulaR1C1 = "=RC[1]&CHAR(9)&RC[2]"
                ary(n) = .Address(True, True, xlR1C1, True)
            End With
        End If
    Next

    dst.Consolidate _
            Sources:=ary, _
            Function:=xlSum, _
            TopRow:=True, _
            LeftColumn:=True

    Set dst = dst.CurrentRegion.Columns(1)
    dst.Offset(1, 1).Resize(, 2).ClearContents

    dst.Offset(1).TextToColumns _
            Destination:=dst.Offset(1, 1), _
            DataType:=xlDelimited, _
            Tab:=True

    Set dst = dst.CurrentRegion
    Set dst = Intersect(dst, dst.Offset(, 3))

    dst.Sort _
            Key1:=dst.Rows(1), _
            Order1:=xlAscending, _
            Header:=xlNo, _
            Orientation:=xlLeftToRight

    For Each ws In Worksheets
        ws.Columns(1).Delete
    Next

 End Sub

（マナ） 2016/10/22(土) 21:12

コメント返信：

[ 一覧(最新更新順) ]

[[20161021192104]] 『統合で左から2列までの項目を固定』（匿名） ページの最後に飛ぶ

[[20161021192104]]　『統合で左から2列までの項目を固定』（匿名）　ページの最後に飛ぶ