[[20160921221222]] 『複数シートから1シートに纏めるマクロ』(すみれ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数シートから1シートに纏めるマクロ』(すみれ)

 [[20051206110657]] 『金銭出納帳』(satomi)

 過去ログと類似した表を作成しており、条件追加をしたいのですが
 もし可能でありましたら教えていただけますでしょうか。

 【Sheet1-3】(Sheet4以降もある)があり【まとめ】(Sheet)でまとめたいです。
※複数シートにある、コード1を1行で纏めたいです。

 【Sheet1】
     A         B         C        D     E
 コード1   科目    摘要    金額    (項目が増える場合有)
 P00001   通信費  切手代    800
 P00002   消耗品  ペン    100
 S000001  医療費  ○○医院  1200

 【Sheet2】
     A         B         C        D     E       
 コード1  商品名1   金額    (項目が増える場合有)
 P00002   デスク  20,000
 S000001  椅子   10,000
 S001000    電話機  15,000

 【Sheet3】
     A         B         C        D     E        
 コード1  商品名2    金額    (項目が増える場合有)
 P00001   定規      500
 P00002   マーカー  100
 S000500  はさみ      200

 【まとめ】
     A         B         C        D          E        F         G         H
 コード1   科目    摘要    金額   商品名1  金額    商品名2   金額
 P00001   通信費  切手代    800                        定規     500
 P00002   消耗品  ペン    100   デスク  20,000   マーカー   100
 S000001  医療費  ○○医院  1200   椅子   10,000
 S000500                                                     はさみ     200
 S001000                                  電話機  15,000

< 使用 Excel:Excel2013、使用 OS:Windows8 >


 こんばんわ。

 Sheet1の構成は、コード1・科目・摘要・金額 となってますが、
 Sheet2以降は、コード1・商品名1・金額 のように科目が無くて、摘要が商品名になってますが、
 これはこの通りで合ってるんですか?

 1シートのデータ件数が数百程度なら、共通のコードがあるようですので、IFERROR関数とVLOOKUP関数で参照するのが一番簡単です。

 B2 =IFERROR(VLOOKUP($A2,Sheet2!$A$2:$D$1000,COLUMN(B1),0),"")
 D列と下にオートフィル
 E列より右も同じようにシート名だけ変えて同じ式で良いです。

(sy) 2016/09/22(木) 00:19


 それともマクロの勉強をしたいと言う事でしょうか?

(sy) 2016/09/22(木) 00:25


 あっ、すいません、要件見落としてました。

 各シート横に項目が追加されて、1つのシート内でも1つのコードで複数項目を取り扱う事があるんですね?

 でもそれなら尚更Sheet1と他のシートの項目の構成や列数が違うのは、本当に例の通りなんですか?

 他にも例えばSheet2の横に商品名が追加されたら、項目名はどうなるんですか?
 商品名2になるんですか?
 でもSheet3で商品名2は使ってるので、纏めた時にどのシートの項目か分からなくなりますね。

 項目が増えた時の例も無いと、雑な回答しか返せません。

(sy) 2016/09/22(木) 07:18


 >> (項目が増える場合有)

 この意味は

 ・項目が増えても、まとめシートでは、それらは相手にしない。

 ・項目が増えた場合は、自動的にそれらもまとめしーとに反映させる。

 どちらですか?

(β) 2016/09/22(木) 07:57


Sub main()
    Dim sht As Worksheet, rg As Range, wc As Long, tc As Long, tr As Long
    With Sheets("まとめ")
        .Cells.ClearContents
        For Each sht In ThisWorkbook.Sheets
            If sht.Name Like "Sheet*" And sht.Range("A1").Value = "コード1" Then
                wc = sht.Range("A1").CurrentRegion.Columns.Count - 1
                tc = .Range("A2").Offset(, Columns.Count - 1).End(xlToLeft).Offset(, 1).Column
                sht.Range("B1").Resize(, sht.Range("B1").Offset(, Columns.Count - 2).End(xlToLeft).Column) _
                .Copy .Range("A2").Offset(, Columns.Count - 1).End(xlToLeft).Offset(, 1)
                For Each rg In sht.Range("A1").CurrentRegion.Resize(, 1)
                    tr = lastr(rg.Value)
                    .Range("A" & tr) = rg.Value
                    .Cells(tr, tc).Resize(, wc).Value = rg.Offset(, 1).Resize(, wc).Value
                Next rg
            End If
        Next sht
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("A3:A" & Rows.Count), SortOn:=xlSortOnValues, Order:=xlAscending
        .Sort.SetRange .Range("A2").CurrentRegion
        .Sort.Header = xlYes
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
        .Sort.Apply
        .Rows(1).Delete Shift:=xlUp
    End With
End Sub
Function lastr(arg As String) As Long
    Set setf = Sheets("まとめ").Columns("A:A").Find(What:=arg, LookAt:=xlWhole)
    If setf Is Nothing Then
    lastr = Sheets("まとめ").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    Else
    lastr = setf.Row
    End If
End Function
(mm) 2016/09/23(金) 15:07

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.