- ベストアンサー
Excel 複数シートから複数条件を別シートに
- みんなの回答 (5)
- 専門家の回答
質問者が選んだベストアンサー
条件が複雑で大分苦労しましたが関数で処理する方法です。 関数で処理することでシートの数が多くなっても即座に対応できますし(ここでの例では10シートまで)、データがそれぞれのシートに新たに追加された場合でも即座にお求めの表が自動的に変更されますので、常に最新のデータがお求めの表に表示されていることになります。マクロでは操作を行わなければ最新のデータの表示とはなりませんね。また、お求めの表では2カ月間の表示とは限らずに、例ですが、6カ月間までを表示させることもできるようになっています。 なお、日付の入力は6/1や6月1日のように入力しても数式バー上では2013/6/1のように日付として認識されていることが必要です。また、まとめの表では6月のデータとするときには6/1や2013/6/1のように入力してからセルの表示形式のユーザー定義で m月 のようにして6月と表示させるようにします。 これから示す例ではまとめの表をシート幾つに作成してもよいのですがシート3にまとめの表を表示させるとします。 初めに各会社ごとのシート、シート1、シート2、シート4、シート5・・・について作業列をG列に設けます。各シートのG2セルには次の式を入力して下方にドラッグコピーします。作業に当たっては例えば6月と7月の表を作るとしたらシート3のA3セルに2013/6/1、A4セルには2013/7/1 のように入力しておくのがよいでしょう。入力が無い場合には空白のままのセルとなります。 =IF(D2="","",IF(COUNTIF(Sheet3!A$3:A$8,DATE(YEAR(D2),MONTH(D2),1))>0,DATE(YEAR(D2),MONTH(D2),1)*1000+COUNTIF(D$2:D2,">="&DATE(YEAR(D2),MONTH(D2),1))-COUNTIF(D$2:D2,">="&DATE(YEAR(D2),MONTH(D2)+1,1)),"")) そこでまとめのシートですが例えばシート3に作るとして次のようにします。 B1セルから横方向には会社名をA社、B社、C社・・・のようにK1セルまでに入力します。 B2セルから横のセルには対応するシート名を入力します。例えばB2セルにSheet1、C2セルにSheet2、D2セルにSheet4などと半角英数文字で実際のシート名に合う文字で入力します。 A3セルからA8セルまでには表示させたい月を6月と7月の表を作りたい場合にはA3セルには2013/6/1、A4セルには2013/7/1のように必ず月の初めの日付で入力します。その後にA3セルからA8セルを選択してセルの表示形式の「ユーザー定義」で m月 のようにして6月、7月のように表示させます。 B3セルには次の式を入力して右横方向のK3セルまでドラッグコピーしたのちに下方の8行目までドラッグコピーします。 =IF(OR($A3="",B$2=""),"",IF(ROW(A1)=1,IF(COLUMN(A1)=1,0,OFFSET(B3,0,-1)),IF(ROW(A1)>1,IF(COLUMN(A1)=1,MAX($B2:$K2),OFFSET(B3,0,-1))))+COUNTIF(INDIRECT(B$2&"!G:G"),">="&$A3*1000)-IF($A4="",0,COUNTIF(INDIRECT(B$2&"!G:G"),">="&$A4*1000))) お求めの表は10行目から下方に表示させることにします。 A10セルには発注一覧表と入力します。 B11セルには得意先、C11セルには発注No、D11セルには商品名、E11セルには納品日とそれぞれ文字列を入力します。 A12セルには次の式を入力して下方にドラッグコピーします。 =IF(ROW(A1)=1,A3,IF(COUNTIF(INDEX(B$3:K$8,1,COUNT(B$3:K$3)):INDEX(B$3:K$8,6,COUNT(B$3:K$3)),ROW(A1)-1)=0,"",IF(INDEX(A$3:A$8,MATCH(ROW(A1)-1,INDEX(B$3:K$8,1,COUNT(B$3:K$3)):INDEX(B$3:K$8,6,COUNT(B$3:K$3)),0)+1)=0,"",INDEX(A$3:A$8,MATCH(ROW(A1)-1,INDEX(B$3:K$8,1,COUNT(B$3:K$3)):INDEX(B$3:K$8,6,COUNT(B$3:K$3)),0)+1)))) 数値が表示されますがシリアル値が表示されますので、それらのセル範囲についてはセルの表示形式から日付を選んで好みの日付表示にします。 次のB12セルには次の式を入力して下方jにドラッグコピーします。 =IF(ROW(A1)>MAX($B$3:$K$8),"",IF(MIN(INDEX($B$3:$K$8,MATCH(LOOKUP(10^10,$A$12:$A12),$A$3:$A$8,0),1):INDEX($B$3:$K$8,MATCH(LOOKUP(10^10,$A$12:$A12),$A$3:$A$8,0),10))>=ROW(A1), $B$1,INDEX($B$1:$K$1,MATCH(ROW(A1)-0.1,INDEX($B$3:$K$8,MATCH(LOOKUP(10^10,$A$12:$A12),$A$3:$A$8,0),1):INDEX($B$3:$K$8,MATCH(LOOKUP(10^10,$A$12:$A12),$A$3:$A$8,0),10),1)+1))) 会社名が表示されます。 C12セルには次の式を入力してE12セルまで横にドラッグコピーしたのちに下方にもドラッグコピーします。 =IF($B12="","",INDEX(INDIRECT(INDEX($B$2:$K$2,MATCH($B12,$B$1:$K$1,0))&"!A:E"),MATCH(LOOKUP(10^10,$A$12:$A12)*1000+COUNTIF(INDEX($B$12:$B12,MATCH(10^10,$A$12:$A12)):$B12,$B12),INDIRECT(INDEX($B$2:$K$2,MATCH($B12,$B$1:$K$1,0))&"!G:G"),0),IF(COLUMN(A1)<=2,COLUMN(A1),IF(COLUMN(A1)=3,5)))) 納品日の列にはシリアル値が表示されますのでそれらの範囲を選択してからセルの表示形式で日付から好みの日付表示に変更します。 以上で作業は終了です。式が複雑で理解するのが容易ではないと思いますが、お示しした通りでここに示した式をそのままコピーして一度試験してみてください。
その他の回答 (4)
- MarcoRossiItaly
- ベストアンサー率40% (454/1128)
皆さんが回答されているとおりマクロで処理すればご要望の表を作ることは可能と思いますが、今後のことを考えると、Sheet1 と Sheet2 を合わせて 1 つの表にしておくことをお勧めします。 具体的には、Sheet1 の左端あたりに 2 列を挿入。空白になっている B1 セルに「A 社」と記入。ダブルクリックにより下方向にオートフィル。念のため、A 列の各行には、1 などから始まる通し番号あるいはそれに類するものを振る。Sheet2 も同じ位置に「B 社」と通し番号を記入。Sheet2 には 1,000 行データが存在するとして、Sheet2 の A1:G1000 のセル範囲をコピーし、Sheet1 の最下行の次の行に貼り付け。最後に、Sheet2 を削除。これだけです。 これにより、Sheet1 にフィルタを取り付ければ日付ほかの項目で絞り込みができるし、ピボットテーブルも使えます。今回ご質問の表も、パッと作れるということになります。行の並べ替えも自由にできるし、通し番号を使えばいつでも元どおりの順序に戻せます。
頭の体操のつもりで、考えている間に、すでに回答されていますが、答えさせていただいていいでしょうか。作業はシート4でやることと、項目が絞込みをしていない点が課題から外れていますが、目的は達されていると思います。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2013/6/14 ユーザー名 : ' ' Dim sht1gyosu As Integer, sht2gyosu As Integer, sht4gyotop As Integer, sht4gyoend As Integer Sheets("Sheet1").Select sht1gyosu = Cells(Rows.Count, 1).End(xlUp).Row 'MsgBox sht1gyosu Range(Cells(1, 1), Cells(sht1gyosu, 5)).Select Selection.Copy Sheets("Sheet4").Select Range("A1").Select ActiveSheet.Paste Sheets("Sheet2").Select sht2gyosu = Cells(Rows.Count, 1).End(xlUp).Row ' MsgBox sht2gyosu Range(Cells(2, 1), Cells(sht2gyosu, 5)).Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet4").Select sht4gyotop = sht1gyosu + 1 sht4gyoend = sht1gyosu + sht2gyosu Range(Cells(sht4gyotop, 1), Cells(sht4gyoend, 5)).Select Range("A8").Select ActiveSheet.Paste Range("A1:E15").Select Application.CutCopyMode = False Selection.AutoFilter Selection.AutoFilter Field:=4, Criteria1:="<>" Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("A2") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin End Sub
- tom04
- ベストアンサー率49% (2537/5117)
No.1です! 前回のコードで2か所訂正してください。 仮に10月~12月のデータがあると2月よりも先に表示されてしまいます。 前回のコードで >.Formula = "=MONTH(F2)&""月""" の行を >.Formula = "=MONTH(F2)" に そして >.Range("A:A").NumberFormatLocal = "0""月""" の1行を 最後から5行目 >.Columns.AutoFit と >End With の間に追加して With wS3 .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous .Range("A1").Resize(1, 5).HorizontalAlignment = xlCenter .Columns.AutoFit .Range("A:A").NumberFormatLocal = "0""月""" End With これでSheet3のA列が昇順で表示されると思います。 何度も失礼しました。m(_ _)m
- tom04
- ベストアンサー率49% (2537/5117)
こんばんは! SheetはSheet1(A社)・Sheet2(B社)とSheet3だけという前提です。 VBAになりますが一例です。 Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面に ↓のコードをコピー&ペーストしてマクロを実行してみてください。 (Alt+F8キー → マクロ → マクロ実行です) 尚、Sheet1のSheet名はA社・Sheet2はB社という名前になっているとします。 Sub Sample1() 'この行から Dim i As Long, endRow, wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet, wS4 As Worksheet Set wS1 = Worksheets("A社") '←Sheet名は実際のSheet名に! Set wS2 = Worksheets("B社") '←Sheet2も同様! Set wS3 = Worksheets("Sheet3") '←Sheet3も・・・ Application.ScreenUpdating = False Worksheets.Add after:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = "作業用" Set wS4 = Worksheets("作業用") On Error Resume Next endRow = wS3.Cells(Rows.Count, "B").End(xlUp).Row If endRow > 1 Then wS3.Rows(2 & ":" & endRow).ClearContents End If With wS4 wS1.Range("A1").Resize(1, 5).Copy .Range("C1") wS1.Cells(1, "D").AutoFilter field:=4, Criteria1:="<>" i = wS1.Cells(Rows.Count, "A").End(xlUp).Row If i > 1 Then Range(wS1.Cells(2, "A"), wS1.Cells(i, "E")).Copy .Cells(Rows.Count, "C").End(xlUp).Offset(1) End If endRow = .Cells(Rows.Count, "C").End(xlUp).Row Range(.Cells(2, "B"), .Cells(endRow, "B")).SpecialCells(xlCellTypeBlanks) = wS1.Name wS1.AutoFilterMode = False wS2.Cells(1, "D").AutoFilter field:=4, Criteria1:="<>" i = wS2.Cells(Rows.Count, "A").End(xlUp).Row If i > 1 Then Range(wS2.Cells(2, "A"), wS2.Cells(i, "E")).Copy .Cells(Rows.Count, "C").End(xlUp).Offset(1) End If endRow = .Cells(Rows.Count, "C").End(xlUp).Row Range(.Cells(2, "B"), .Cells(endRow, "B")).SpecialCells(xlCellTypeBlanks) = wS2.Name wS2.AutoFilterMode = False i = wS4.Cells(Rows.Count, "B").End(xlUp).Row With Range(wS4.Cells(2, "A"), wS4.Cells(i, "A")) .Formula = "=MONTH(F2)&""月""" .Value = .Value End With endRow = .Cells(Rows.Count, "A").End(xlUp).Row .Range("A1").CurrentRegion.Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes Range(.Cells(2, "A"), .Cells(endRow, "G")).Copy wS3.Range("A1") With wS3.Range("A1") .Value = "発注一覧表" .Offset(, 1) = "得意先" wS1.Range("A1").Resize(1, 5).Copy .Range("C1") End With Range(.Cells(2, "A"), .Cells(endRow, "G")).Copy wS3.Range("A2") wS3.Range("E:F").Delete For i = wS3.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1 If wS3.Cells(i, "A") = wS3.Cells(i - 1, "A") Then wS3.Cells(i, "A").ClearContents End If Next i Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With With wS3 .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous .Range("A1").Resize(1, 5).HorizontalAlignment = xlCenter .Columns.AutoFit End With Application.ScreenUpdating = True MsgBox "処理完了" End Sub 'この行まで こんな感じではどうでしょうか?m(_ _)m
お礼
KURUMITO様 お礼が遅くなりました。 記載するのを忘れていたのですが、マクロについてほとんど知識がない為、関数でどうにかできないものかと考えておりました。 理解するのにだいぶ時間がかかってしまいましたが、お知恵を拝借しなんとか処理することが出来ました。 質問してよかったです。 他の回答者様も、ありがとうございました。