[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数シートから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
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.