No.1
- 回答日時:
こんばんは!
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
No.2
- 回答日時:
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
No.3
- 回答日時:
頭の体操のつもりで、考えている間に、すでに回答されていますが、答えさせていただいていいでしょうか。
作業はシート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
No.4
- 回答日時:
皆さんが回答されているとおりマクロで処理すればご要望の表を作ることは可能と思いますが、今後のことを考えると、Sheet1 と Sheet2 を合わせて 1 つの表にしておくことをお勧めします。
具体的には、Sheet1 の左端あたりに 2 列を挿入。空白になっている B1 セルに「A 社」と記入。ダブルクリックにより下方向にオートフィル。念のため、A 列の各行には、1 などから始まる通し番号あるいはそれに類するものを振る。Sheet2 も同じ位置に「B 社」と通し番号を記入。Sheet2 には 1,000 行データが存在するとして、Sheet2 の A1:G1000 のセル範囲をコピーし、Sheet1 の最下行の次の行に貼り付け。最後に、Sheet2 を削除。これだけです。
これにより、Sheet1 にフィルタを取り付ければ日付ほかの項目で絞り込みができるし、ピボットテーブルも使えます。今回ご質問の表も、パッと作れるということになります。行の並べ替えも自由にできるし、通し番号を使えばいつでも元どおりの順序に戻せます。
No.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))))
納品日の列にはシリアル値が表示されますのでそれらの範囲を選択してからセルの表示形式で日付から好みの日付表示に変更します。
以上で作業は終了です。式が複雑で理解するのが容易ではないと思いますが、お示しした通りでここに示した式をそのままコピーして一度試験してみてください。
この回答へのお礼
お礼日時:2013/06/18 16:43
KURUMITO様
お礼が遅くなりました。
記載するのを忘れていたのですが、マクロについてほとんど知識がない為、関数でどうにかできないものかと考えておりました。
理解するのにだいぶ時間がかかってしまいましたが、お知恵を拝借しなんとか処理することが出来ました。
質問してよかったです。
他の回答者様も、ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの警告について
-
エクセルの数式バーのフォント...
-
Excelの区切り文字について質問...
-
8:40までの出勤は全て8:30に...
-
【Excel VBA】 テキストファイ...
-
excelVBAについて。
-
Excelで<a>,<b>の入ったセルをc...
-
EXCELの散布図で日付が1900年に...
-
【再投稿】レイアウトが異なる...
-
【Excel】日付に連動してプルダ...
-
エクセルでファイルの最終更新...
-
大容量があつかえるソフトを探...
-
エクセル VBA 参照設定とイ...
-
Excelの計算で差分を求める場合...
-
Excel 標準フォントについて教...
-
Excelについて教えてください ...
-
Excel 小さくなったスクロール...
-
excelファイルの内容検索
-
年間の医療費のデータがあり、...
-
エクセルの計算式について(COU...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの警告について
-
エクセルデーターから必要な項...
-
エクセルでファイルの最終更新...
-
複数のテキストファイルをexcel...
-
Excelの複数条件の関数
-
【マクロ】ファイル名の一括変...
-
EXCELの散布図で日付が1900年に...
-
マクロの処理が遅くなった
-
Excelの時刻の不思議
-
エクセルでの2項目比較および...
-
Excelマクロで空白セルを詰めて...
-
エクセルの数式バーのフォント...
-
ExcelでASCを使って全角を半角...
-
エクセルで80万行、50列位のデ...
-
今まで文字化けなく開けていたc...
-
エクセルのことで教えてくださ...
-
エクセルVBA 月の中で、月~土...
-
Excelでの表の作り方
-
Excel セルにおけるフォント設...
-
エクセルの質問です。 F列からL...
おすすめ情報