Results of 1 - 1 of about 19659 for 20�����������������������... (0.004 sec.)
- [[20150313132454]]
- #score: 2681
- @digest: 6b244261482c38de5d83bfbfdce4cb80
- @id: 67496
- @mdate: 2015-03-24T01:13:17Z
- @size: 32910
- @type: text/plain
- #keywords: 業11 (104931), 品11 (97390), 出元 (47160), 件シ (46575), （33 (35688), 計用 (24374), 商品 (18907), 元ブ (17324), 用シ (12629), 抽出 (11780), fname (10784), 作業 (10309), 2015 (8170), ブッ (7790), 数量 (6766), 品名 (6001), シー (5503), （β (5054), ート (4376), currentregion (4207), 集計 (4093), ック (4086), 合計 (4062), トル (3813), 罫線 (3775), 業列 (3571), クの (3113), sheet2 (3102), ッセ (3082), メッ (3067), タイ (2854), セー (2722)
- 『別ブックの表の合計欄がゼロ以外の全ての値を抽出』（333）
BOOK1に商品名などが入力されている表があります。 A列に商品名 B〜H列に数を入力 I列に合計 1列めは全て項目名 2列めから上記の物を入力しております。 BOOK1を毎月名前を付けて保存で同じファイル内に 2015年1月 2015年2月 2015年3月 とどんどん作っていきます。 そして集計用BOOKのsheet2に 月ごとに合計欄が0以外の商品の商品名と合計数を抽出し、毎月sheet2に抽出結果が 溜まっていくような表をつくりたいのです。 手作業を考えましたが毎月の商品名がかなりの量なので 簡単に抽出できないかと思い調べましたがなかなか理想のものを探すことができず 質問させて頂きました。 BOOK1のファイルを毎月名前を付けて保存で増やしていくので マクロボタンなどを集計用BOOKのsheet2上に表示させ そのボタンを押すことでファイル名(日付で）を指定したりして なんとか商品名と数量合計欄を抽出したいです。 集計用BOOKのsheet2は A列商品名 B列作業用 C列数量 このようなレイアウトになっております。 どなたかわかる方よろしくお願い致します。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- >BOOK1を毎月名前を付けて保存で同じファイル内に 同じファイル内?? 同じフォルダ内 かな? （β） 2015/03/13(金) 13:56 ---- すみません。同じフォルダ内の間違えです。 （333） 2015/03/13(金) 14:08 ---- 今、出先で、コードがかけないんですが、以下のような流れでいけると思います。 マクロブックに作業シート（隠しシートでもOK）を作っておき その A1 に、集計用BOOKの該当シートののA1、商品名のタイトルと同じものをセット。 その B1 に、同じく集計用BOOKの該当シートの I1、合計のタイトルと同じものをセット。 その D1 にも 合計のタイトルと同じものをセット。 その D2 に <>0 といれておく。 ここまでが準備作業 で、コードは GetOpenFileName 等のファイル選択ダイアログを表示して、ブックを選択させる。 そのブックを開く そのブックの当該シートのデータ域を指定したフィルターオプション 条件欄が作業シートの D1:D2 別の場所に抽出。その抽出先が作業シートのA1:B1 作業シートに抽出されたもののタイトル行を除き、集計BOOKのSHeet2の最後の行の1つ下の A列に作業シートの A1:A○、 C列に作業シートの B1:B○ をコピペ。 そのブックを閉じる 一度、上記の手順で操作して、それをマクロ記録とれば、ほとんどの部分のコードが生成されるので あとは、それをブラッシュアップしてらいいかと。 （β） 2015/03/13(金) 14:39 ---- 上記の作業をやってマクロをボタンに割り当てれば 毎月ファイルが増えてもボタンを押すだけで反映されますか? （333） 2015/03/13(金) 19:22 ---- ファイルはダイアログから操作者に選んでもらう流れなので、ファイルが何千個できてもOKですよ。 ボタンを押すだけで、操作者が思っているファイルをマクロが自動で選別するなんてことは、超能力者じゃないと無理だけど。 もちろん「上記作業をやって」それを「マクロ記録して」、できあがったコードを「ブラッシュアップして」 それをボタンに割り当てるんですよ。 （β） 2015/03/13(金) 20:02 ---- 提示の流れで GetOpenFileName 等のファイル選択ダイアログを表示して、ブックを選択させる。 これはマクロ記録できませんので、その部分のみ、以下の Test1 として。 また、別の方法として操作者に、年月を指定させる方法もあります。これが Test2。 こちらでは、 2015/3 とか 2015年3月 といった指定ができます。 Sub Test1() 'フォルダからブックを選択させる場合 Dim fName As Variant fName = Application.GetOpenFilename("ExcelBook,*.xls*", , "処理するブックの選択") If fName = False Then Exit Sub 'キャンセルボタン '★ ブックを開き、処理をして保存して閉じるコードをここに。 '★ 開くべきブックは fName End Sub Sub Test2() '年月を指定させて処理する場合 Dim myPath As String Dim ymd As Long Dim fName As String Dim ck As String 'C:¥Users¥xxxxxx¥Test¥ の場合 myPath = Environ("USERPROFILE") & "¥Test¥" 'DeskTop の中のフォルダなら ' myPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "¥Test¥" 'ドキュメント の中のフォルダなら ' myPath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "¥Test¥" ymd = Application.InputBox("対象年月を入力してください", Type:=1) fName = Format(ymd, "yyyy年mm月") & ".xlsx" 'ブックの存在チェック" ck = Dir(myPath & fName) If ck = "" Then MsgBox fName & " が存在しません" Exit Sub End If '★ ブックを開き、処理をして保存して閉じるコードをここに。 '★ 開くべきブックは myPath & fName End Sub （β） 2015/03/14(土) 09:04 ---- 上の作業をやってみたのですが うまく商品名と数量のみを抽出できずに困っております。 抽出先のsheetが A作業列 B商品名 C〜H数量入力 I合計 J作業列 K商品名L〜Q数量入力 R合計 の表になっているためだと思います。 上記で詳しくフォーマットを説明せずにすみません。 Iの合計を境に縦に抽出を行いたいのですができますでしょうか? （333） 2015/03/17(火) 10:40 ---- フォーマットも、そうですが、 >うまく商品名と数量のみを抽出できずに困っております といわれても、それはコードが悪いからでしょう、あるいは操作手順が間違っていたからでしょうとしかコメントできません。 どんなコードで実行しているのか、あるいは、操作であれば、どんな値をどこに与えながら操作したのかがわかりませんので。 そちらのコードをアップ、あるいは、そちらの操作を逐一、説明してください。 （β） 2015/03/17(火) 11:42 ---- 追加で 抽出元のブック群ですが、 A〜I と J〜R、ブロックが2つありますが、抽出したいのはどちらですか、あるいは両方、あるいは両方の合算? で、この2つのブロックのタイトルですが、同じですか?異なっていますか? たとえば B1 は商品1、K1 は商品2 とか? それとも、どちらも同じ? それと >うまく商品名と数量のみを抽出できずに困っております。 どう、うまくいかないのか、エラーになるのか、思ったような結果にならないのか、そのあたりも 具体的に（エラーなら、どんな操作をしたときにどんなエラーになったのか、思ったようなけっかにならないなら こんな結果になってほしかったのに、こうなってしまった）説明してくださいね。 （β） 2015/03/17(火) 11:56 ---- 2つのブロックのタイトルは同じで 両方を抽出し、抽出元のシートは横並びになっていますが 集計シートでは縦1列に商品名 作業列 数量を抽出したいです。 マクロはうまくいかなかったので削除してしまいましたが 手順としては標準作業をし、集計用ブックにsheet1の作業用シートを設け マクロの記録ボタン実行後、抽出用ブックを開き抽出用シート1をフィルターオプション 集計用ブックsheet1に抽出できずに止まってしまいました。 （333） 2015/03/17(火) 12:05 ---- レイアウトが変更（しかも対象の場所が2か所）になったんだから、アップした操作手順も、それなりに調整しないと いけないんだけど、それを、やりとりしていると、それだけで、何日もかかりそうなので、コード案をアップします。 もし、具合悪ければ、レイアウトに関する誤解があるということなので、指摘願います。 事前準備（ちょっと変更しています） 1.マクロブックに"条件"という名前の作業シート（隠しシートでもOK）を作成。 2.その A1 に、集計用BOOKの該当シートのB1,K1商品名のタイトルと同じものをセット。 3.その B1 に、集計用BOOKの該当シートのA1,J1作業列のタイトルと同じものをセット。 4.その C1 に、集計用BOOKの該当シートのI1,R1合計列のタイトルと同じものをセット。 5.その E1 にも 合計のタイトルと同じものをセット。 6.その E2 に <>0 といれておく。 これは一度やっておけば、それでOK。 なお、抽出元ブックの中の抽出シートは、そのブックの最初のシートにしている。 また、このシートにシート保護はかかっていないという前提です。 で、コード。 Sub Test() Dim shF As Worksheet Dim shT As Worksheet Dim shW As Worksheet Dim fName As Variant Dim col As Variant Dim pos As Range fName = Application.GetOpenFilename("ExcelBook,*.xls*", , "処理するブックの選択") If fName = False Then Exit Sub 'キャンセルボタン Set shT = ThisWorkbook.Sheets("Sheet2") '集計用シート Set shW = Sheets("条件") '条件指定の作業用隠しシート Set shF = Workbooks.Open(fName).Sheets(1) '★選んだブックの最初のシートを抽出シートとする For Each col In Array(shF.Range("A1").CurrentRegion.Columns("A:I"), shF.Range("A1").CurrentRegion.Columns("J:R")) '合計欄 0 以外を抽出 col.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=shW.Range("E1:E2"), CopyToRange:=shW.Range("A1:C1"), Unique:=False '転記 With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then '抽出あり? With shT.Range("A1").CurrentRegion Set pos = shT.Range("A" & .Rows.Count + 1).Resize(, 3) End With pos.Resize(.Rows.Count - 1).Value = .Cells.Offset(1).Resize(.Rows.Count - 1).Value End If End With Next '抽出元ブックを閉じる shF.Parent.Close False End Sub （β） 2015/03/17(火) 15:56 ---- ありがとうございます。試して結果をご報告します。 もしも抽出用シートが増えた場合などはどのように対応すれば良いか教えていただけますか? とりあえず、上のコードを今は外出中なので、また試して一度結果をご報告します。 （333） 2015/03/17(火) 16:10 ---- >もしも抽出用シートが増えた場合などはどのように対応すれば良いか教えていただけますか? 対象のシート名が、これとこれ といったように特定できるなら、ほんのちょっとの改造でいけますが? （β） 2015/03/17(火) 16:51 ---- 試してみたのですが col.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=shW.Range("E1:E2"), CopyToRange:=shW.Range("A1:C1"), Unique:=False ここの部分で止まってしまいました。 抽出先ブックの抽出シートのフォーマットは 商品名 作業列 数量になっております。 条件というシートを作って試しました。 （333） 2015/03/18(水) 10:44 ---- とまったときにでたメッセージはどういうものでしたか? メッセージの内容を教えてください。（正確に） おそらく、「フィールド名がどうこう」というもの? フィルターオプション処理でありがちな間違いにより、よくでるメッセージです。 条件シートの A1:C1 の3つのセルに、各抽出元から抜き出すべき項目名をいれるわけですが この3つの項目を抽出元から抜き出そうとしたときに、抽出元に、そのタイトルと全く同じものがないと 抽出できず、このエラーになります。 すべての抽出元のブックの最初のシートの1行目のタイトル、全く同じものになっていますか? たとえば 条件シート側には "商品名" でも、抽出元側には 2つのブロックの1つでも、"商品 名" になっているとエラーです。 （β） 2015/03/18(水) 11:15 ---- そのメッセージでした、ですが抽出元と条件シートは全く同じの商品名と 作業列項目と合計になっております。 条件もE1とE2に 合計 <>0と入力いたしました。 （333） 2015/03/18(水) 11:20 ---- 何度か試してみて一応抽出ができました。 ですがJ〜Rまでの値のみ抽出との結果になりました。 （333） 2015/03/18(水) 11:43 ---- 詳しくフォーマットを説明しときます。 抽出元シート 商品名 作業列 数量 条件シート A商品名 B作業 C合計 D空白 E合計 <>0 抽出先シート1 A作業列 B商品名 C〜H数量入力項目 I合計 J〜RもA〜I同様 抽出先シート2も同じフォーマット 抽出先シート3〜5 A3:N4商品（○○）○○の部分は3〜5とも内容が違います。 A5:D5 商品別の項目（缶詰、汁物類、など） この項目はセルの途中でも存在しこの項目の下に抽出したい商品名があります。 E‾Gまでは数量を入力する項目になってます。 H〜Nも上記と同じように項目が入っていて一つの表になってます。 ここにはGの後Nの後に合計欄を加えるつもりです。 ただ商品名とかなどの決まった項目ではなく商品の種類別項目になってるので こちらは難しいのかなと半ば諦めております。 （333） 2015/03/18(水) 14:57 ---- 14:57 アップの説明は、今から読みますが、QA掲示板でよくあるケースにはまりこんでいますね。 こちらではテスト環境をつくってコードを試して結果OKだと思っている、だけど質問側は、できません、あるいはエラーです。 QA掲示板の宿命ですね。質問の意図を誤解している、そのレイアウトを誤解している、一方で質問側も 回答側のコメントを誤解している、あるいはよくわからないまま、とにかく動かして、思うようにならない・・ これは避けることができない壁で、でも、乗り越えなきゃいけない。 のりこえるためには、双方、「努力」と「協力」が必要ですね。 たとえば、（β） 2015/03/18(水) 11:15 でメッセージを【正確に】教えてほしいと依頼、だけど回答は 「そのメッセージでした」 エラーメッセージにはエラー番号とメッセージ文言があって、エラー番号が同じでもメッセージ文言が異なる場合もあるし メッセージ文言が【よく似ていても】エラー番号によって、意味が異なるものが少なくないです。 まぁ、今回のフィルターオプションの場合のメッセージは、これでよしとしましょう。 >何度か試してみて一応抽出ができました。 これは、ありえません。同じコードで同じデータを扱えば、それがエラーになるなら、何百回やってもエラーになります。 エラーなしで進んだということは、 ・コードを直した ・データを直した ・設定（条件シート）を直した いずれかです。どう直したのかを具体的に連絡もらえれば、あぁ、そうか、こちらの勘違いだ、コードも直そうといった アクションもとれます。何を直したのかわからない状態で、前はエラーだったけど、今は大丈夫といわれても じゃぁ、コードはこのままでいいのかどうか? 悩みますよ。 ●何をどう直して、処理が進んだのかを具体的に教えてください。 次に、「ですがJ〜Rまでの値のみ抽出との結果になりました。 」 これは、集計用シートの結果ですか? 条件シートの結果ではないですか? 条件シートは、条件記述の他に作業用に使っています。 目的のブックの A:Iのみを抽出して、集計用シートに【追加】 次に、J:R【のみを】抽出し、それを集計用シートに【追加】 なので、処理後の条件シートには、J:R【のみが】残っています。 追加で。 まだ、レイアウト説明はすべて読んでいませんが読みかけたところで、あれ?と。 まぁ、最終的には、そちらの実際のブック構成に合わせますが、現状では、 マクロブック "条件" シート いろんな条件を設定。かつ、選んだ抽出元ブックからの抽出をいったん、このシートで受ける。 "Sheet2" 集計用シート。抽出されたデータを最終的に、ここに【追加】してため込んでいく。 選んだ抽出元ブック コード内で Set shF = Workbooks.Open(fName).Sheets(1) '★選んだブックの最初のシートを抽出シートとする と、コメントつけて説明しているつもりだったけど、抽出してくるシートは【1つだけ】 そのブックの最初のシート。 もし、そうじゃないなら、そうじゃない、2つ目のシートもありますと、そうレスしてほしい。 アップされた説明を見ると、抽出シート1,2,が同じフォーマトと書いてある。 これは初めて説明をうけるんだけど、2つのシートなの? 3,4,5については、今後増えたらどうするかとの追加質問の件だと理解。それはそれで一段落したら対応予定。 だけど、現在は、あくまで抽出元シートは1枚でいいんだよね? （β） 2015/03/18(水) 16:14 ---- 抽出先のデータの項目をそのままコピペして条件シートに 貼り付け、マクロ実行で条件シートにJ〜Rの値が貼り付けられました。 最終的にはおっしゃる通りで集計シートにため込んでいく形にしたいです。 抽出元シートは 抽出シート1と2があり同じフォーマットになっています。 すみません、説明不足でした。 なので合計で5シートを抽出したい形に現在なっております。 （333） 2015/03/18(水) 18:24 ---- いや、そういうことを聞いているのではなく、（β） 2015/03/17(火) 15:56 の現在のコードで 選んだブックの A:I、J:R の対象のものが、ちゃんと マクロブックの集計用シートにため込まれていますか? それとも、結果は、そうなっていないのですか? そういうことを聞いています。 条件シートに存在するデータは、↑で説明した通りの作業用データです。 あくまで、集計用シートはどうなりましたかと聞いています。 それと、現行のコードは抽出シート2は相手にしていませんので、それを対応するなら、今の課題がクリアになってからですね。 （β） 2015/03/18(水) 19:03 ---- 追加で ●何をどう直して、処理が進んだのかを具体的に教えてください。 こう、お願いしています。 回答をお願いしますね。 （β） 2015/03/18(水) 20:41 ---- 集計用シートにはためこまれてません。 条件シート以外はなにも、アクションがない状態になってます。 条件シートにJ〜Rの値が貼り付けられただけになってます。 （333） 2015/03/18(水) 20:50 ---- ●何をどう直して、処理が進んだのかを具体的に教えてください。 これについてはいかがですか。 （β） 2015/03/18(水) 21:50 ---- それは上記に書いたとおりです。 フィールド名がないか、または無効なフィールド名です。 このメッセージがでていたので 条件シートの項目を抽出元シートからコピペして貼り付け それでマクロを実行、条件シートにはJ〜Rの値が抽出されました。 それ以外は何もアクションはないです。 （333） 2015/03/18(水) 22:24 ---- レスありがとうございます。 以下、協力いただけませんか。 1.新規ブックの標準モジュールに以下のマクロ MakeDataをコピペして実行してください。 2.出来上がったブックを任意のフォルダに任意の名前を付けて保存して閉じてください。 マクロがあるのでメッセージが出ますので、はい を押してマクロなしの xlsx にしてください。 Sub MakeData() Dim sh As Worksheet Dim i As Long Set sh = ThisWorkbook.Sheets(1) sh.Cells.Clear sh.Range("A1:I1").Value = Array("作業列", "商品名", "数量1", "数量2", "数量3", "数量4", "数量5", "数量6", "合計") sh.Range("J1:R1").Value = Array("作業列", "商品名", "数量1", "数量2", "数量3", "数量4", "数量5", "数量6", "合計") For i = 2 To 21 sh.Cells(i, 1).Value = "作業1" & i sh.Cells(i, 2).Value = "商品1" & i If i Mod 2 = 0 Then sh.Cells(i, 3).Resize(, 7).Value = 0 Else sh.Cells(i, 3).Resize(, 7).Value = 10 End If Next For i = 2 To 11 sh.Cells(i, 1 + 9).Value = "作業2" & i sh.Cells(i, 2 + 9).Value = "商品2" & i If i Mod 2 <> 0 Then sh.Cells(i, 3 + 9).Resize(, 7).Value = 0 Else sh.Cells(i, 3 + 9).Resize(, 7).Value = 20 End If Next End Sub 3.もう1つ新規ブックを立ち上げて、その標準モジュールに以下のマクロをコピペ。 Sub Prepare() Dim sh2 As Worksheet On Error Resume Next Set sh2 = Sheets("Sheet2") On Error GoTo 0 If sh2 Is Nothing Then Worksheets.Add Before:=Worksheets(Worksheets.Count) ActiveSheet.Name = "Sheet2" End If Worksheets.Add Before:=Worksheets(1) ActiveSheet.Name = "条件" With Sheets("条件") .Range("A1:C1").Value = Array("商品名", "作業列", "合計") .Range("E1").Value = "合計" .Range("E2").Value = "<>0" End With With Sheets("Sheet2") .Cells.Clear .Range("A1:C1").Value = Array("商品", "作業列", "合計") End With End Sub Sub Test2() Dim shF As Worksheet Dim shT As Worksheet Dim shW As Worksheet Dim fName As Variant Dim col As Variant Dim pos As Range fName = Application.GetOpenFilename("ExcelBook,*.xls*", , "処理するブックの選択") If fName = False Then Exit Sub 'キャンセルボタン Set shT = ThisWorkbook.Sheets("Sheet2") '集計用シート Set shW = ThisWorkbook.Sheets("条件") '条件指定の作業用隠しシート Set shF = Workbooks.Open(fName).Sheets(1) '★選んだブックの最初のシートを抽出シートとする For Each col In Array(shF.Range("A1").CurrentRegion.Columns("A:I"), shF.Range("A1").CurrentRegion.Columns("J:R")) '合計欄 0 以外を抽出 col.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=shW.Range("E1:E2"), CopyToRange:=shW.Range("A1:C1"), Unique:=False '転記 With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then '抽出あり? With shT.Range("A1").CurrentRegion Set pos = shT.Range("A" & .Rows.Count + 1).Resize(, 3) End With pos.Resize(.Rows.Count - 1).Value = .Cells.Offset(1).Resize(.Rows.Count - 1).Value End If End With Next '抽出元ブックを閉じる shF.Parent.Close False '集計用シート表示 shT.Select End Sub 4.Prepare を実行してください。 5.Test2 を実行してください。 ブックの選択画面で、2.で保存したブックを選んでください。 結果はどうなるでしょうか。連絡いただけますか? （β） 2015/03/19(木) 07:56 ---- 結果をご報告します。 5までを実行した結果は 条件sheet 商品名 作業列 合計 合計 商品22 作業22 20 <>0 商品24 作業24 20 商品26 作業26 20 商品28 作業28 20 商品210 作業210 20 sheet2 商品 作業列 合計 商品13 作業13 10 商品15 作業15 10 商品17 作業17 10 商品19 作業19 10 商品111 作業111 10 商品113 作業113 10 商品115 作業115 10 商品117 作業117 10 商品119 作業119 10 商品121 作業121 10 商品22 作業22 20 商品24 作業24 20 商品26 作業26 20 商品28 作業28 20 商品210 作業210 20 の結果になりました。 sheet1,3にはなにもアクションはなかったです。 （333） 2015/03/19(木) 09:54 ---- これでいいんですよね? 最終目的は集計用シートでのためこみ。で、今回実行してもらったコードでは、それをSheet2にしていますので。 選んだブックの A:I と J:R の数量合計がゼロではないものがすべて、集計用シートに反映していますよね? Sheet1やSheet3は、もともと、相手にしていませんので。 （β） 2015/03/19(木) 11:18 ---- そうです!実際のもので試してみます! 結果ご報告します! （333） 2015/03/19(木) 11:32 ---- 出来ました!ちゃんとsheet2に結果が溜めこまれました! ありがどうございます! sheet2に罫線や色などがはいっていたのですが、これを保ちつつ値をうつすことは 難しいですか? 実行後は色や罫線は消えてしまい、値が溜めこまれる形になっています。 （333） 2015/03/19(木) 12:25 ---- よかったです。 今、そちらで動かしているコード、そのままコピペでアップいただけませんか。 Sheet2の罫線などの書式対応や、今後の抽出元ブックのシートが1枚じゃなく2枚の対応も 加味してみます。 そのあとの、複雑なシート3,4,5 といったものも、シートのレイアウト基準（レイアウトルール）が わかれば（フィルーターオプションは難しいかもしれませんが）対応を考えることはできると思います。 （β） 2015/03/19(木) 12:59 ---- 第一報。 Sheet2(集計用シート）の罫線等はいっさい変更されないはずですよ。 Sheet2へは、値のみを転記していますので。 もしかして、罫線などがあったのは、抽出元ブックのほうですか? もし、そうなら、う〜ん・・・・ せっかくのフィルターオプションがつかえないかも。 追記 17:42 あっ!もしかして （β） 2015/03/19(木) 07:56 で作ったマクロブックのSheet2のことをいってますか? もし、そうなら、これは、仮のテストマクロブックですから、本番のマクロブックのマクロを Test2 でいれかえてもらえばいいのですが? もちろん、今回作った新しいマクロブックを正として運用していくなら、今回のブックのSheet2に あらためて罫線などをつけてもらう必要はありますが? （β） 2015/03/19(木) 17:41 ---- sheet2にもともとあった罫線が実行後消えてしまいました。 一応コードにsheet2とかかれた部分を実際のsheetの名前に変更して マクロを実行しました。 （333） 2015/03/20(金) 09:58 ---- 実際の実行コード（TestやTest2)では罫線他書式は一切触っていませんし、こちらでSheet2に罫線をセットして Test2を実行させても、罫線は消えません。 テスト用環境を作成してもらうためにアップした Prepareでは、確かに罫線があればクリアしていますが これは、 > 3.もう1つ新規ブックを立ち上げて、その標準モジュールに以下のマクロをコピペ。 こうコメントした通り、テスト環境としての実行マクロを含んだブックを作成してもらうためです。 これを、本番ブックに組み込んで、動かしたのでしょうか? このPrepareは テスト環境作成用ですから、本番では動かしません。 で、もう1つの Test2 は、今までの Test と基本的にはかわりません。 （シート修飾で気になるところがあったので1か所変更したのと、処理後に Sheet2を表示させるコードを追加しただけ） なので、本番ブックの Test を、今回の Test2 で置き換えていただくことはOKですが、本番処理に Prepare は全く必要ありませんので。 ●今回、確認したかったことは、Test も Test2 も処理ロジックはかえておらず、つまり、 「今までも、実は Sheet2 にあたるブックにため込まれていたんでしょ?だから、今までもOKだったんでしょ?」 ということなんですが。 ●さて、処理自体はOKになったと思います。 この先、選択した抽出元ブックに抽出すべきシートが2枚あった時の対応をやりましょうか? それとも、本トピは、解決ということで閉じられますか? （β） 2015/03/20(金) 10:36 ---- 二枚の対応もお願いしたいです。 かなり表の商品名が多いので自動で出来たら助かります! （333） 2015/03/20(金) 11:02 ---- 罫線の件はOKということでいいですね? まず、選択したブックの最初の2枚のシートに決め打ちして抽出するパターンです。 かりに、そのブックのシートが1枚しかなくてもOKにしています。 Sub Test3() Dim bkF As Workbook Dim shF As Worksheet Dim shT As Worksheet Dim shW As Worksheet Dim fName As Variant Dim col As Variant Dim pos As Range Dim x As Long fName = Application.GetOpenFilename("ExcelBook,*.xls*", , "処理するブックの選択") If fName = False Then Exit Sub 'キャンセルボタン Set shT = ThisWorkbook.Sheets("Sheet2") '集計用シート Set shW = ThisWorkbook.Sheets("条件") '条件指定の作業用隠しシート Set bkF = Workbooks.Open(fName) '選んだブック For Each shF In bkF.Worksheets '選んだブックからシートを取り出す x = x + 1 If x > 2 Then Exit For For Each col In Array(shF.Range("A1").CurrentRegion.Columns("A:I"), shF.Range("A1").CurrentRegion.Columns("J:R")) '合計欄 0 以外を抽出 col.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=shW.Range("E1:E2"), CopyToRange:=shW.Range("A1:C1"), Unique:=False '転記 With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then '抽出あり? With shT.Range("A1").CurrentRegion Set pos = shT.Range("A" & .Rows.Count + 1).Resize(, 3) End With pos.Resize(.Rows.Count - 1).Value = .Cells.Offset(1).Resize(.Rows.Count - 1).Value End If End With Next Next '抽出元ブックを閉じる bkF.Close False '集計用シート表示 shT.Select End Sub （β） 2015/03/20(金) 11:23 ---- こちらは、選んだ抽出元ブックの中から抽出すべきシート名が決まっているというケースです。 コード内のシート名を実際のものにかえて試してみてください。 なお、先にアップした、先頭のシートから枚数指定で抜き出すものも、今アップするものも、コードとしては 2枚のシートを相手にしていますが、いずれも、「シートレイアウトが同じなら」何枚でも対象に増やしていくことは わずかなコードの変更で可能です。 ●Test3,Test4が一段落したら、次の レイアウトが異なるシートの対応にすすみますかね? Sub Test4() Dim bkF As Workbook Dim shF As Worksheet Dim shT As Worksheet Dim shW As Worksheet Dim fName As Variant Dim col As Variant Dim pos As Range fName = Application.GetOpenFilename("ExcelBook,*.xls*", , "処理するブックの選択") If fName = False Then Exit Sub 'キャンセルボタン Set shT = ThisWorkbook.Sheets("Sheet2") '集計用シート Set shW = ThisWorkbook.Sheets("条件") '条件指定の作業用隠しシート Set bkF = Workbooks.Open(fName) '選んだブック For Each shF In bkF.Worksheets '選んだブックからシートを取り出す Select Case shF.Name Case "抽出1", "抽出2" '対象シート名 実際のものに For Each col In Array(shF.Range("A1").CurrentRegion.Columns("A:I"), shF.Range("A1").CurrentRegion.Columns("J:R")) '合計欄 0 以外を抽出 col.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=shW.Range("E1:E2"), CopyToRange:=shW.Range("A1:C1"), Unique:=False '転記 With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then '抽出あり? With shT.Range("A1").CurrentRegion Set pos = shT.Range("A" & .Rows.Count + 1).Resize(, 3) End With pos.Resize(.Rows.Count - 1).Value = .Cells.Offset(1).Resize(.Rows.Count - 1).Value End If End With Next End Select Next '抽出元ブックを閉じる bkF.Close False '集計用シート表示 shT.Select End Sub （β） 2015/03/20(金) 11:30 ---- 試してみました。 Test3では抽出した範囲にはフィールド名がないか、または無効なフィールド名です。 のエラーがcol.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=shW.Range("E1:E2"), CopyToRange:=shW.Range("A1:C1"), Unique:=False の部分ででてしまいました。 Test4は 抽出1の部分はうまく反映されるのですが 2のほうは反映されていません。 （333） 2015/03/20(金) 13:09 ---- まず、従来のコードと今回の Test3,4は基本的に同じです。 元ブックから取り込むシートを増やしているだけです。 ですから、Test3 のエラーは、選択したブックの1枚目のシートはOKだったのでしょうから、2枚目のシートのタイトルに 商品名 作業列 合計 のいずれかがないという現象です。シートを調べてみてください。 (このあたりは、今までの取り組みで十分にわかっているところだと思います。まずタイトルが一致しているかどうか それを調べて、その状態もあわせて報告してくださいね） Test4 のほうは、抽出1であろうが、抽出2であろうが、コードロジックは同じです。 ですから、抽出2 という、コードで相手にしているシートがない（全角、半角も一致している必要があります） あるいは、その名前のシートはあるけど、対象（合計がゼロではないもの）がないか、どちらかでは? （β） 2015/03/20(金) 13:21 ---- test3うまく実行できましたが、やはり抽出1しか抽出できません。 Test4のほうですがsheet名も確認し合計欄もゼロでないものがあるか確認しましたが やはり抽出1のみしか抽出することが出来ません。 （333） 2015/03/20(金) 14:40 ---- 以前もそうでしたけど、 >Test3では抽出した範囲にはフィールド名がないか、または無効なフィールド名です。 でも、 >test3うまく実行できましたが エラーになるなら何度やってもエラーです。 何か直したんですよね? それを、ここが、こうなっていたので直したらOKになったと報告いただかないと 「たまたまOKだったのかな?ロジックのチョンボは、まだなおっていないのかな?調べよう」と、こちらは、そういうことを 続けなきゃいけません。 ●どこをどうしたか（どこが、どうなっていたか）を教えてください。 （うまくいったんだから、もういいじゃないか ということではなく、重要なことですから） いずれにしてもそちらでは Test3もTest4も1枚目のシートしか処理されなかったということですね? ほんとですか? Sheet2に、ほんとに溜め込まれていませんか? いままでも、Sheet2にためこまれていたのに、ずっと（なぜか）ためこまれていない、不具合だと そういってきましたよね?まぁ、疑うわけではありませんが、そちらの勘違いということもあるので。 一度、Sheet2をクリアしてから実行するとわかりやすいかもしれませんよ。 （β） 2015/03/20(金) 15:00 ---- 全てをイコールをつかって値をあわせ実行したら成功しました。 クリアして試しましたがどちらもsheet1のみの抽出になりました。 （333） 2015/03/23(月) 09:59 ---- >全てをイコールをつかって値をあわせ実行したら成功しました。 ということは、マクロコードの問題ではなく、抽出しようとしているブックのシートのタイトルが 指定の文字列ではなかったということですね? フィルターオプション処理をすると、必ずといっていいほど、この件で、Q/Aのやりとりをしなきゃいけないので 実行前に、タイトルの整合性がとれているかどうかをチェックして、不整合なら、メッセージを出して 終了させる構えにしたほうが（回答側にとって）労力のせつやくになるのかな? と、最近、思い始めています。 >sheet1のみの抽出になりました。 （β） 2015/03/19(木) 07:56 で提示した、2.の部分、テストブック作成マクロ、MakeData で新規ブックを作成し それにSheet2があれば、Sheet1 のセルをすべてコピペでSheet2 に転記、Sheet2がなければ、シート挿入で Sheet2を作成した上で、Sheet1の内容をSheet2にコピペ。 これを任意の名前で保存した上で、Test3 を実行してみてください。 元ブックのSheet1もSheet2も同じ内容なので見づらいかもしれませんが、うまくいけば、マクロブックの Sheet2 には、Sheet1からだけの抽出の2倍のデータがあるはずです。 確認お願いします。 （β） 2015/03/23(月) 17:30 ---- 商品名 作業列 合計 商品13 作業13 10 商品15 作業15 10 商品17 作業17 10 商品19 作業19 10 商品111 作業111 10 商品113 作業113 10 商品115 作業115 10 商品117 作業117 10 商品119 作業119 10 商品121 作業121 10 商品22 作業22 20 商品24 作業24 20 商品26 作業26 20 商品28 作業28 20 商品210 作業210 20 こんな感じの結果になりました。 （333） 2015/03/24(火) 09:40 ---- 不思議ですねぇ。 実行は （β） 2015/03/20(金) 11:23 の Test3 でやりましたか? （β） 2015/03/19(木) 07:56 の Test2 であれば、報告された結果になりますが Test3 でやれば、こちらでは 商品13 作業13 10 商品15 作業15 10 商品17 作業17 10 商品19 作業19 10 商品111 作業111 10 商品113 作業113 10 商品115 作業115 10 商品117 作業117 10 商品119 作業119 10 商品121 作業121 10 商品22 作業22 20 商品24 作業24 20 商品26 作業26 20 商品28 作業28 20 商品210 作業210 20 商品13 作業13 10 商品15 作業15 10 商品17 作業17 10 商品19 作業19 10 商品111 作業111 10 商品113 作業113 10 商品115 作業115 10 商品117 作業117 10 商品119 作業119 10 商品121 作業121 10 商品22 作業22 20 商品24 作業24 20 商品26 作業26 20 商品28 作業28 20 商品210 作業210 20 になりますが??? （β） 2015/03/24(火) 10:13... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201503/20150313132454.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97055 documents and 608272 words.
訪問者：