Results of 1 - 1 of about 103 for フォーマット 自動 印刷 (0.009 sec.)
フォーマット (1423), 自動 (14517), 印刷 (5709)
- [[20120528114720]]
- #score: 8137
- @digest: e4ab7ec8c2a8edc10ce349f5a77f8cd2
- @id: 59087
- @mdate: 2012-06-06T03:52:27Z
- @size: 43641
- @type: text/plain
- #keywords: 羽毛 (155782), 抱合 (147556), 票ブ (125141), 単品 (120373), 毛布 (89874), 票枚 (88129), dataid (87651), 具羽 (85919), newflag (72799), 寝具 (70402), 伝票 (61294), 布団 (54616), shw (50894), 票作 (49498), 便名 (40590), 品" (36714), 定日 (25672), 原紙 (22855), 枝番 (16028), 枚数 (13033), 月30 (9994), ブッ (8725), 合せ (8657), 2012 (8292), 規ブ (8067), fname (7605), 区分 (7437), 個数 (6677), 抽出 (5951), 商品 (5942), 通常 (5940), ック (5691)
- 『複数の条件を指定して伝票を作成』（にょろ）
Windows7、Excel2007です。 下記のように「単品データ」「抱合せデータ」の2つのシートがあります。 ※単品は伝票1枚につき1種類の商品を出荷したもの、抱合せは伝票1枚で複数の商品を出荷したもの 単品データ A B C D E F G H I J K L M N O 連番 入力日 便名 区分 枝番 可否 No 売場 商品名 メーカー品番 伝票枚数 個数 指定日 備考 ピッキング 1 2012/5/28 1便 通常 030 寝具 羽毛布団 AAA-AAA01 1 1 5月30日 aaa 2 2012/5/28 1便 至急 029 台所 圧力鍋 SASS-DD2S 1 2 6月1日 3 2012/5/28 1便 通常 031 寝具 羽毛枕 AAM-BBB02 1 1 5月30日 抱合せデータ ※1つの伝票で複数の商品を出荷する→商品が複数あっても伝票の枚数は「1」とカウント A B C D E F G H I J K L M N O 連番 入力日 便名 区分 枝番 可否 No 売場 商品名 メーカー品番 伝票枚数 個数 指定日 備考 ピッキング 1 2012/5/28 3便 通常 001 030 寝具 羽毛布団 AAA-AAA01 1 1 5月30日 aaa 2 2012/5/28 3便 通常 001 031 寝具 羽毛枕 AAM-BBB02 1 5月30日 3 2012/5/28 4便 先日付 002 251 ギフト タオル TTTSET-03 1 2 5月29日 bbb これらのデータを元に、下記のようなレイアウトの伝票を作成します 「単品」データから「入力日・便名・区分」で抽出した伝票 B C D E F G H I J K L 3 2012/5/28 1便 4 5 6 通常 7 8 可否 No 売場 商品名 メーカー品番 伝票枚数 個数 指定日 備考 ピッキング 9 030 寝具 羽毛布団 AAA-AAA01 1 1 5月30日 aaa 10 031 寝具 羽毛枕 AAM-BBB02 1 1 5月31日 「抱合せ」データも同様に「入力日・便名・区分」で抽出します。 「抱合せ」データの枝番は後の「期間毎集計」で使用するので伝票には載りません。 1枚の伝票には50件の商品が記載され、50件を超えるごとに2枚目、3枚目…と次の伝票になり、 それぞれにページ番号が入ります（フッター部分でも可） @まず「単品データ」「抱合せデータ」のそれぞれからユーザーフォームで ・種別（単品か抱合せか）→コンボボックス(cSyubetu) ・入力日→テキストボックス(tDate) ・便名→コンボボックス(cBin) ・区分→コンボボックス(cKubun) を選択し、コマンドボタンクリックで伝票の雛形（「原紙 単品」「原紙 抱合せ」）をコピーして伝票を作成しようと 思うのですが、複数の条件を指定してデータシートから該当のデータを抽出するにはどうしたらよいでしょうか。 Aその後、入力日の期間を指定して（例「2012/5/11〜2012/6/10」）各区分（4種あります）毎に集計をします。 集計は A B C D E F No 商品名 伝票枚数 個数 指定日 指定日毎個数 のようなレイアウトになっていて、 ・商品毎 および ・指定日があるものは、同じ指定日でいくつ出荷したか をキーに集計します。 「抱合せ」については上記に記載したように、複数の商品で1枚の伝票になったりします。 これもユーザーフォームかインプットボックスから期間を指定したいのですが、ただ商品の 個数を集計するだけでなく、伝票の枚数や指定日・指定日毎の個数も集計しなければいけないので どのようにすればよいかで途方に暮れています… 不足な点は補足しますので、どのようにすればよいかお教えください… ---- >複数の条件を指定してデータシートから該当のデータを抽出するにはどうしたらよいでしょうか。 提示のレイアウトであれば、フィルター処理がベストだと思う。 オートフィルターでもフィルターオプションでも。 フィルタリングされた行を SpecialCells あたりで抽出して伝票に展開。 フィルタオプションであれば、作業用の別シートに抽出すれば、単純に、そこにある行を伝票に反映させればいいので そちらを推奨。 で、いくつかのテーマがあって、その、どれもが必要なので、あれもこれもという気持ちも理解できるけど 1つずつ、片付けていったらいいと思うな。 かつ、業務要件を提示して、フルセットの出来上がりを期待しているけど、もちろん、それもアリだとは思うけど そうなると、あそこはどうなってる、ここは、どうしたい? と、質問側/回答側のやりとりが延々と続くような 気もするね。 そうじゃなく、もっとシンプルなレイアウト（項目数も5〜6項目）をベースに、 ・複数条件で対象のものを抽出する部分 ・抽出したものを、シンプルな伝票レイアウトに反映させる部分 ・おなじく、それを、シンプルな集計シートに反映する部分 こういったものにわけて、そちらで作ってみて、その中で、自分でできるところは、質問しなくてもいい訳で、 わからないところに絞って回答をもらえば、あとは、それを、実際のレイアウトにあてこむだけなので、 そちらでもできるよね。 とりあえず、アップされた要件で、わからないところは想像しながら、考えてみようかなとも思うけど、 上でコメントしたアプローチがいいんじゃないかなぁ、本件は。 追記）ユーザーフォームかインプットボックスから期間を指定したい・・・・ これなんかも、どこで指定しようが、開始、終了 が与えられれば、それをベースに処理すればいいんだけど ユーザーフォームでやる場合はどういうコードか、全くわからない、インプットボックスでやる場合は どんなコードの記述になるのか全くわからない、それらも含めて（業務要件のみならずコードレベルでも） フルセット必要なのかどうか? 回答側で、どのレベルでレスしたらいいのか、ちょっと悩むねぇ。 (ぶらっと) ---- たとば部品として。 現在のブックに "作業" という名前のシートを追加して、以下の Test1 を実行すると "作業"シートに指定した条件のデータが転記されるはず。 Sub Test1() '以下ではコンスタントで抽出キーを与えているが、実際には cSyubetu.Value や tDate.Value を使う。 MsgBox 抽出("単品", "2012/5/28", "2便", "通常") End Sub Function 抽出(DataID As String, OutDate As String, DlvCycle As String, DlvType As String) As Long '引数は全てテキストボックスや、コンボボックス入力を想定して文字列 'DataID "単品" かそれ以外か 'OutDate 文字列で "2012/5/10" 等 日付型として受け入れられる型式 'DlvCycle 1便、2便 等 'DlvType 通常、至急 等 '戻り値は抽出データ件数 Dim sh As Worksheet If DataID = "単品" Then Set sh = Sheets("単品データ") Else Set sh = Sheets("抱合せデータ") End If With Sheets("作業") '抽出用作業シート .Cells.ClearContents .Range("Q1:S1").Value = sh.Range("B1:D1").Value .Range("Q2").Value = CDate(OutDate) .Range("R2").Value = DlvCycle .Range("S2").Value = DlvType sh.Columns("A:O").AdvancedFilter xlFilterCopy, .Range("Q1").CurrentRegion, .Range("A1") .Range("Q1").CurrentRegion.Clear 抽出 = .UsedRange.Rows.Count - 1 End With End Function (ぶらっと) ---- ありがとうございます。 自分なりにフィルタオプションのやり方を検索してコードを書いていたのですが… ※「単品データ」「抱合せデータ」のP列に「種別」の項目を設置、「単品」か「抱合せ」かをP列に記載 ※「条件用」=抽出条件を書きだすシート ※「抽出用」=条件に一致したデータを書きだすシート Private Sub CommandButton1_Click() Dim z As Long Dim wsT As Worksheet Dim wsD As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 抽出条件 As Range Set wsT = Worksheets("単品データ") Set wsD = Worksheets("抱合せデータ") Set ws2 = Worksheets("条件用") Set ws3 = Worksheets("抽出用") Set 抽出条件 = ws2.Range("A1").CurrentRegion If Me.cSyubetu.Text = "" Then MsgBox "作成する伝票種別を選択してください", vbInformation Exit Sub End If With Sheets("条件用") z = .Range("A" & .Rows.Count).End(xlUp).Row + 1 .Cells(z, 1).Value = CDate(tDate.Text) '入力日 .Cells(z, 2).Value = cBin.Value '便名 .Cells(z, 3).Value = cKubun.Value '区分 .Cells(z, 4).Value = cSyubetu.Value '種別 z = z + 1 End With If cSyubetu.Value = "単品" Then wsT.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ criteriarange:=抽出条件, copytorange:=ws3.Range("A1"), _ unique:=False ws3.Range("A1").CurrentRegion.Sort key1:=ws3.Range("B1"), _ order1:=xlAscending, Header:=xlYes ElseIf cSyubetu.Value = "抱合せ" Then wsD.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ criteriarange:=抽出条件, copytorange:=ws3.Range("A1"), _ unique:=False ws3.Range("A1").CurrentRegion.Sort key1:=ws3.Range("B1"), _ order1:=xlAscending, Header:=xlYes End If End Sub 上記を実行しましたが「抽出用」にデータが抽出されませんでした。 ぶらっと様のコードではうまくいったのですが、 > '以下ではコンスタントで抽出キーを与えているが、実際には cSyubetu.Value や tDate.Value を使う。 この部分ですが、実際はユーザーフォームのコントロールで抽出キーを書きだしていますが、どのように応用すればいいのでしょうか? 例では標準モジュールにコードを書いていますが、ユーザーフォームだとユーザーフォームモジュールとどのように 結びつければよいのかと思いまして… （にょろ） ---- >この部分ですが、実際はユーザーフォームのコントロールで抽出キーを書きだしていますが、どのように応用すればいいのでしょうか? >例では標準モジュールにコードを書いていますが、ユーザーフォームだとユーザーフォームモジュールとどのように結びつければよいのか ユーザーフォーム側で、 Call 抽出(cSyubetu.Value, "tDate.Text, cBin.Value, cKubun.Value) こんなように。 で、抽出プロシジャは ユーザーフォームモジュールに書いてもいいし、標準モジュールに書いてもいい。 コード管理という面では、ユーザーフォームモジュールに一元化したほうがいいかな? 続いて次の部品をアップしておくね。 ↑のTest1 で "作業" シートが作成された後、Test2 を実行すると、新規ブックとして 伝票ブックを作成。シート名は 1,2,3 ・・・ としている。 ページ番号のセット位置は、適切なところに変更して。（コードでは L60 にしている） なお、このブックを印刷、あるいは保存といったことについては、そちらの要件で 伝票作成プロシジャに追加してもいいし、別マクロにしてもいい。そのあたりは、自分でできるよね? Sub Test2() '以下ではコンスタントでデータ種別を与えているが、実際には cSyubetu.Valueを使う。 Call 伝票作成("単品") End Sub Sub 伝票作成(DataID As String) '引数はテキストボックスや、コンボボックス入力を想定して文字列 'DataID "単品" かそれ以外か Dim shG As Worksheet Dim shW As Worksheet Dim shD As Worksheet Dim z As Long Dim i As Long Dim x As Long Dim wb As Workbook Dim flag As Boolean Application.ScreenUpdating = False If DataID = "単品" Then Set shG = Sheets("原紙 単品") Else Set shG = Sheets("原紙 抱合せ") End If Set shW = Sheets("作業") z = shW.UsedRange.Rows.Count - 1 z = z ¥ 50 If z Mod 50 > 0 Then z = z + 1 For i = 1 To z If Not flag Then shG.Copy Set wb = ActiveWorkbook flag = True Else shG.Copy After:=wb.Sheets(Sheets.Count) End If Set shD = ActiveSheet x = (i - 1) * 50 + 2 With shD .Range("C3").Value = shW.Range("B2").Value .Range("I3").Value = shW.Range("C2").Value .Range("G6").Value = shW.Range("D2").Value .Range("C9:L58").Value = shW.Cells(x, "F").Resize(50, 10).Value .Range("L60").Value = "P." & i 'ページ番号 場所は適切なところを指定 .Name = i End With Next Application.ScreenUpdating = True MsgBox "伝票ブックを作成しました" End Sub (ぶらっと) ---- で、↑が片付けば、集計表なんだけど、これについては、イメージがまだわかないな。 たとえば、アップされている単品、抱きあわせの状態で、具体的に、どのようなイメージになるのかを アップしてくれると、要件を理解できるかもしれない。 (ぶらっと) ---- ありがとうございます。 Test2のコードで「伝票ブックを作成しました」というメッセージは出るのですが、この「新規ブック」がどこにも見つかりません… 同じフォルダ内にもありませんし… 「新規シート」ではなく「新規ブック」なのでしょうか? 何度もすみません… （にょろ） ---- 上でもコメントしたけど、新規ブックを作るけど保存はしていないので、どのフォルダにもないよ。 ただ、メッセージがでるのに、新規ブックがエクセル上に見当たらない? 考えられることは1つだけ。アップしたコードはちょっと手を抜いていて、作業シートに1行も抽出されていなければ 伝票ブックは作らないんだけど、最後に必ずメッセージ出している。 "作業"シートに抽出はされていた? (ぶらっと) ---- ↑ 追記 ユーザーフォームの既存ロジックに組み込んで動かしたのかな? 最終的には、もちろん、そうするわけだけど、単体の機能テストというか確認として アップした Test1 は動いたということだから、今回のTest2 も標準モジュールに書いて もう1度、アップした Test1 を動かし、その後、続けて Test2 を動かしてみてくれない? (ぶらっと) ---- 最初はユーザーフォームに組み込んでいましたが、新規ブックが作成されないので標準モジュールにTest2をコピーして実行しました。 今標準モジュールでTest1→Test2を実行しましたが新規ブックが作成されません（伝票ブックを作成しましたのメッセージは出ます） 作業シートにデータは抽出されています。 （にょろ） ---- 集計表ですが、「単品データ」「抱合せデータ」に毎日データが追加されていきます。 例 単品データ A B C D E F G H I J K L M N O 連番 入力日 便名 区分 枝番 可否 No 売場 商品名 メーカー品番 伝票枚数 個数 指定日 備考 ピッキング 1 2012/5/28 1便 通常 030 寝具 羽毛布団 AAA-AAA01 1 1 5月30日 aaa 2 2012/5/28 1便 至急 029 台所 圧力鍋 SASS-DD2S 1 2 6月1日 3 2012/5/28 1便 通常 031 寝具 羽毛枕 AAM-BBB02 1 1 5月30日 4 2012/5/29 2便 至急 251 台所 包丁 DD-AA-002 1 3 6月上旬 : 550 2012/6/20 6便 先日付 030 寝具 羽毛布団 AAA-AAA01 1 2 6月25日 このように入力されたデータの中で、 ・期間（2012/5/28〜2012/6/10のように指定） ・便名 ・区分 この3つをキーに集計します。 例:2012/5/28〜2012/6/10、便名「1便」、区分「通常」の集計表 A B C D E F No 商品名 伝票枚数 個数 指定日 指定日毎個数 030 羽毛布団 12 15 030 羽毛布団 2 3 2012/5/30 3 031 羽毛枕 10 17 031 羽毛枕 1 3 6月上旬 3 031 羽毛枕 1 2 2012/6/2 2 上記のように、基本的には「商品」の「伝票枚数」と「個数」を集計するのですが、 ・「指定日」が記入されていない伝票は「伝票枚数」と「個数」のみ集計 ・「指定日」が記入されている伝票は「伝票枚数」「個数」に加えどの指定日で何個出荷されたかについても集計 のように集計します。 「抱合せ」も集計の仕方は同じなのですが、「単品」は1種類の商品につき伝票は1枚であるのに対し、「抱合せ」は 1枚の伝票で複数の商品を出荷するので、伝票枚数のカウントが変わってきます。 例えば A B C D E F G H I J K L M N O 連番 入力日 便名 区分 枝番 可否 No 売場 商品名 メーカー品番 伝票枚数 個数 指定日 備考 ピッキング 1 2012/5/28 3便 通常 001 030 寝具 羽毛布団 AAA-AAA01 1 1 5月30日 aaa 2 2012/5/28 3便 通常 001 031 寝具 羽毛枕 AAM-BBB02 1 5月30日 3 2012/5/28 3便 通常 001 035 寝具 敷布 AAS-CCC03 2 5月30日 4 2012/5/28 3便 通常 002 031 寝具 羽毛枕 AAM-BBB02 1 5 6月1日 上記のデータでは枝番「001」のデータは、伝票1枚で3種類の商品を出荷しています。 なので集計は （5月28日の集計） A B C D E F No 商品名 伝票枚数 個数 指定日 指定日毎個数 030 羽毛布団 1 1 5月30日 1 031 羽毛枕 1 5 6月1日 5 031 羽毛枕 0 1 5月30日 1 035 敷布 0 2 5月30日 2 のように伝票枚数は「枝番」の最初の商品にのみカウントされ、同じ枝番の別の商品にはカウントされません。 この「期間毎集計」も、ユーザーフォームで 「開始日」 「締め日」 「便名」 「区分」 をコントロールで指定し、コマンドボタン実行で集計表を作成したいと思っています。 要領を得ない説明ですみません… （にょろ） ---- >今標準モジュールでTest1→Test2を実行しましたが新規ブックが作成されません（伝票ブックを作成しましたのメッセージは出ます） >作業シートにデータは抽出されています う〜ん・・悩むねぇ。 伝票作成の For i = 1 To z ここにブレークポイントを設定してTest2を実行し とまったら、 まず、マウスを z にあてて、ポップアップされる z の値を確かめて、そこからF8でステップ実行していき、 shG.Copy や shG.Copy After:=wb.Sheets(Sheets.Count) が本当に実行されないのか 確認してくれないかな? 集計表要件整理深謝。まずは、伝票作成が正しく行われてからとりかかるね。 まさかとは思うけど、伝票作成プロシジャと抽出プロシジャで、違う作業シートを相手にしていることは ないよねぇ・・・ (ぶらっと) ---- 伝票作成については↑の答えを待つね。 集計表について。 >「指定日」が記入されている伝票は「伝票枚数」「個数」に加えどの指定日で何個出荷されたかについても集計 どうも、よく理解できていない。 指定日のあるものについて F列を表示というのはわかるけど、 そのときの D列とF列の違いは? 同じものをセットするの? >伝票枚数は「枝番」の最初の商品にのみカウントされ、同じ枝番の別の商品にはカウントされません 抱合せの場合の、この要件は理解した。 ところで、この枝番だけど、たとえば 001 というのは 1ヶ所だけ現れるのかな? それとも、下のほうにいったら、また別のデータで 001 というのがある? 要は、彩番ルールが、どうなっているかということだけど。シートを通じて、001,002,003 というのか、 あるいは、日別に 001,002,003 というのか、あるいは、さらに便ごとに 001,002,003 というのか、 そこの基準を教えてね。 追加質問） >このように入力されたデータの中で、 ・期間（2012/5/28〜2012/6/10のように指定） ・便名 ・区分 この3つをキーに集計します。 これは集計のキーじゃなく、集計すべきもののデータ抽出範囲だよね。 集計のキー（集計表で1行になる単位）を教えて。 (ぶらっと) ---- 昨日は急にお休みしたので遅くなりましてすみません > 伝票作成の For i = 1 To z ここにブレークポイントを設定してTest2を実行し >とまったら、 >まず、マウスを z にあてて、ポップアップされる z の値を確かめて、そこからF8でステップ実行していき、 >shG.Copy や shG.Copy After:=wb.Sheets(Sheets.Count) が本当に実行されないのか >確認してくれないかな? 止まった時点の z は 0 です。 その後ステップ実行すると間を全部飛ばして Application.ScreenUpdating = True に行きます。 For文の部分にカーソルをあてると wb.Sheets(Sheets.Count)=オブジェクト変数またはWithブロック変数が設定されていません .Range("C3").Value =...オブジェクト変数またはWithブロック変数が設定されていません というポップアップが出ます。 >指定日のあるものについて F列を表示というのはわかるけど、 そのときの D列とF列の違いは? 説明がややこしくてすみません。 上司に話を聞きました。 上司のイメージとしては、 A B C D E F No 商品名 伝票枚数 個数 指定日 指定日毎個数 030 羽毛布団 14 18 ←商品の総計 030 羽毛布団 12 15 ←ここから指定日ごとの内訳 030 羽毛布団 2 3 2012/5/30 3 このような感じで、まず同じ商品の「伝票枚数」「個数」の総計を出し、その下に ・指定日なし ・各指定日毎 の内訳を表示するような感じです。 総計の数字と内訳の数字を分かりやすくするためにF列を設けましたが、 A B C D E F No 商品名 伝票枚数 個数 指定日 指定日毎個数 030 羽毛布団 14 18 ←商品の総計 030 羽毛布団 12 15←ここから指定日ごとの内訳 030 羽毛布団 2 2012/5/30 3 このように内訳の部分の個数はF列にだけ記載でもいいと思います。 枝番の件ですが、「日付」「便名」「区分」で集計する時の為のキーなので、枝番「001」はこの3つのキーに一つ割り振られます。 例:120528_1便_通常_001 120528_1便_通常_002 ←日付・便・区分が同じで別の伝票には次の枝番ができる 120528_2便_通常_001 ←便が違うので枝番は初期値から始まる 120528_1便_至急_001 120529_1便_通常_001 >集計のキー（集計表で1行になる単位）を教えて すみません、私がよく理解できてないです… 集計は「商品」毎に行います。 （同じ商品（商品No）で、伝票枚数・個数・指定日・指定日毎個数を出します） このような答えでよろしいでしょうか? よろしくお願いいたします ※追加 Test2を最初からステップ実行していたところ、現在「作業」シートには2行のデータがありますが、 z = shW.UsedRange.Rows.Count - 1 の時点では z = 2 なのですが、 z = z ¥ 50 を通過したところで z = 0 になります。 試しに元データを50行以上にしたら新しいブックが作成されました。 データが50行以下だとブックができないようです… ※さらに追加 一旦56行のデータを作成して伝票ブックが作成されるのがわかったので、 If z > 50 Then z = z ¥ 50 If z Mod 50 > 0 Then z = z + 1 End If このようにしてみました。 そして「単品データ」のデータを2行残して消し、Test1を実行するとメッセージボックスに 消したはずの行数「56」が表示されます（「作業」シートに抽出されているのは2行だけです） なので「単品データ」のシートを、2行目より下の部分を「クリア」ではなく「行削除」を行いました。 するとTest1の結果メッセージボックスには「2」と表示され、Test2で伝票ブックが作成されましが 不要なはずの2枚目のシートまで伝票ブックにできてしまいます。 （伝票ブックにデータが載るのは1枚目のシートの2行だけです） （にょろ） ---- あとすみません、新しく作成されたブックについてシート名を変更したりブックの名前を付けたりっていうのを 過去ログ検索しながらやっていました。 ○作成された伝票シートに「12_05_28_単品_1便_通常」のような名前を付けたい For i = 1 To z If Not flag Then shG.Copy Set wb = ActiveWorkbook flag = True Else shG.Copy After:=wb.Sheets(Sheets.Count) End If Set shD = ActiveSheet x = (i - 1) * 50 + 2 With shD cnt = 1 Syubetu = shW.Cells(z, 16).Value Bin = shW.Cells(z, 3).Value Kubun = shW.Cells(z, 4).Value Bname = Syubetu & "_" & Bin & "_" & Kubun shDate = Application.Text(shW.Cells(z, 2).Value, "YY¥_MM¥_DD") shName = shDate & "_" & Bname Do If Not IsObject(Evaluate("'" & shName & "'!A1")) Then Exit Do cnt = cnt + 1 shName = shDate & "_" & Bname & "(" & cnt & ")" Loop .Range("C3").Value = shW.Range("B2").Value .Range("I3").Value = shW.Range("C2").Value .Range("G6").Value = shW.Range("D2").Value .Range("C9:L58").Value = shW.Cells(x, "F").Resize(50, 10).Value .Range("L1").Value = "P." & i 'ページ番号 場所は適切なところを指定 .Name = shName End With Next ここまででシート名を変更するまではできました。 それで新しいブックなのですが、「日付_便_区分」毎に新しいブックを作成しているとたくさんのブックが作成されてしまうので、 「日付_単品」「日付_抱合せ」の二つのブックにそれぞれの便・区分のシートをまとめて入れたいと思います。 （最初の話では元のデータブックにシートを追加するようになっていたので…） それで、伝票ブック名を「20120528_単品」のような名前にしたいと思います。 例えば最初の伝票作成で「20120528_単品」のブックを作成し、次の伝票を作成する時に「伝票ブックを開く」などのボタンで 該当の伝票ブックを選択・開いてそこに次の伝票を保存… というような流れを想定していますができますでしょうか? （にょろ） ---- >データが50行以下だとブックができないようです… お恥ずかしい・・・汗、汗・・・おそまつでござんした。ペコ! 追加でアップされた説明も含めて、また集計表のコードも含めて、ちょっと時間ください。 (ぶらっと) ---- いったん作成したシートの行を処理前に削除しても状況によっては直前のシートの行数イメージを持ってくるケースは 確かにあるので、その把握を UsedRange から B列データ最終行で行うように、あわせて変更。 で、 >作成された伝票シートに「12_05_28_単品_1便_通常」のような名前を付けたい これについては、簡単なんだけど、以下の要件を確認したあと追加で連絡する。 ・名前をつけるということは、いったん保存するわけだけど 1）そのフォルダは? 指定のフォルダあり? あるいは、このマクロブックと同じフォルダに保存? それとも? 2）もし、保存しようとして、同名のブックがあった場合（再処理した場合等） 無条件に上書き? 同じものがあるよ、上書きする? というメッセージを出して、上書きするかしないかを 決める?（上書きしない場合は、新規ブックのまま）、あるいは、同じものがあれば、メッセージをだすけど コードとしては上書きしない? 伝票作成プロシジャを以下でリバイスしてね。 Sub 伝票作成(DataID As String) '引数はテキストボックスや、コンボボックス入力を想定して文字列 'DataID "単品" かそれ以外か Dim shG As Worksheet Dim shW As Worksheet Dim shD As Worksheet Dim zz As Long Dim z As Long Dim i As Long Dim x As Long Dim wb As Workbook Dim flag As Boolean Application.ScreenUpdating = False If DataID = "単品" Then Set shG = Sheets("原紙 単品") Else Set shG = Sheets("原紙 抱合せ") End If Set shW = Sheets("作業") zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 If zz = 1 Then MsgBox "データが抽出されていません" Exit Sub End If z = z ¥ 50 If zz Mod 50 > 0 Then z = z + 1 For i = 1 To z If Not flag Then shG.Copy Set wb = ActiveWorkbook flag = True Else shG.Copy After:=wb.Sheets(Sheets.Count) End If Set shD = ActiveSheet x = (i - 1) * 50 + 2 With shD .Range("C3").Value = shW.Range("B2").Value .Range("I3").Value = shW.Range("C2").Value .Range("G6").Value = shW.Range("D2").Value .Range("C9:L58").Value = shW.Cells(x, "F").Resize(50, 10).Value .Range("L60").Value = "P." & i 'ページ番号 場所は適切なところを指定 .Name = i End With Next Application.ScreenUpdating = True MsgBox "伝票ブックを作成しました" End Sub (ぶらっと) ---- ありがとうございます。 新規ブック作成されました。 あと、シート名もこちらでいじった内容で変更できました。 ブックの保存に関してですが、マクロブックと同じフォルダで、もし同名のブックがあれば 「上書きしますか? YES/NO」で、もし「NO」（キャンセル）を選んだら新規ブックのまま（自分で名前を付けて保存できるように） でしたいと思います。 今は、伝票を作成するたびに新規ブックが作成されますが、上記に書きましたように一日に作成される伝票ブックは 「単品」「抱合せ」の2つのブックにしたいです。 その際に同じシート名が存在したら「シート名(2)」のようにするのを想定しています。 現在のコードでは便・区分の組合せで1日に48個のブックができてしまうので… よろしくお願いいたします （にょろ） ---- 伝票作成にブック保存を追加。シート名は i のままにしてある。 i->i(2)->i(3) Sub 伝票作成(DataID As String) '引数はテキストボックスや、コンボボックス入力を想定して文字列 'DataID "単品" かそれ以外か Dim shG As Worksheet Dim shW As Worksheet Dim shD As Worksheet Dim zz As Long Dim z As Long Dim i As Long Dim x As Long Dim wb As Workbook Dim flag As Boolean Dim fName As String Dim fPath As String Dim newFlag As Boolean Application.ScreenUpdating = False If DataID = "単品" Then Set shG = Sheets("原紙 単品") Else Set shG = Sheets("原紙 抱合せ") End If Set shW = Sheets("作業") zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 If zz = 1 Then MsgBox "データが抽出されていません" Exit Sub End If fPath = ThisWorkbook.Path & "¥" '12_05_28_単品 fName = Format(CDate(shW.Range("B2").Value), "yy""_""mm""_""dd") & "_" & DataID & ".xlsx" newFlag = True If Len(Dir(fPath & fName)) > 0 Then 'ブックが存在する If MsgBox("すでに" & fName & "が存在します。既存ブックに追加しますか?", vbYesNo) = vbYes Then Set wb = Workbooks.Open(fPath & fName) newFlag = False End If End If z = z ¥ 50 If zz Mod 50 > 0 Then z = z + 1 For i = 1 To z If Not flag And newFlag Then shG.Copy Set wb = ActiveWorkbook flag = True Else shG.Copy After:=wb.Sheets(Sheets.Count) End If Set shD = ActiveSheet x = (i - 1) * 50 + 2 With shD .Range("C3").Value = shW.Range("B2").Value .Range("I3").Value = shW.Range("C2").Value .Range("G6").Value = shW.Range("D2").Value .Range("C9:L58").Value = shW.Cells(x, "F").Resize(50, 10).Value .Range("L60").Value = "P." & i 'ページ番号 場所は適切なところを指定 .Name = getSheetName(wb, CStr(i)) End With Next If Not newFlag Then Application.DisplayAlerts = False wb.SaveAs fPath & fName Application.DisplayAlerts = True End If Application.ScreenUpdating = True MsgBox "伝票ブックを作成しました" End Sub Private Function getSheetName(wb As Workbook, shn As String) As String Dim cnt As Long Dim st As String cnt = 1 st = shn Do If IsError(Evaluate("'[" & wb.Name & "]" & st & "'!A1")) Then Exit Do cnt = cnt + 1 st = shn & "(" & cnt & ")" Loop getSheetName = st End Function (ぶらっと) ---- ぶらっと様 ありがとうございます。 新しいコードを試したのですが、ブック名が fName = Format(CDate(shW.Range("B2").Value), "yy""_""mm""_""dd") & "_" & DataID & ".xlsx" このようにならず、今まで通り「Book1」という名前になります。 なので「120530・単品・1便」の伝票ブックを作成した後、「120530・単品・2便」の伝票を作成すると新しいブックが作成されてしまいます。 ※私事ですが父危篤状態のためなかなかこちらの作業が進まず、教えていただいているのに 時間がかかってしまいまして申し訳ございません。 （にょろ） ---- まずは、私のことは気にせず、お父上のご看病に専念してください。 ↑の不具合と集計表については、早晩、アップするけど、時間が取れるときに、ゆっくり対応いただければそれでいいです。 (ぶらっと) ---- >このようにならず、今まで通り「Book1」という名前になります。 既に存在して、それに追加する場合以外は、あえて新規ブックとして、最後に操作者が自由に名前をつけられるように していたんだけど ・既に存在して、それに追加する場合は その名前 ・既に存在して、それに追加しない場合は 新規ブック ・存在していなければ初めから決められた名前 こういうことだったんだね。 訂正部分は少ないけどフルセット。伝票作成 を置き換えてね。 Sub 伝票作成(DataID As String) '引数はテキストボックスや、コンボボックス入力を想定して文字列 'DataID "単品" かそれ以外か Dim shG As Worksheet Dim shW As Worksheet Dim shD As Worksheet Dim zz As Long Dim z As Long Dim i As Long Dim x As Long Dim wb As Workbook Dim flag As Boolean Dim fName As String Dim fPath As String Dim newFlag As Long Application.ScreenUpdating = False If DataID = "単品" Then Set shG = Sheets("原紙 単品") Else Set shG = Sheets("原紙 抱合せ") End If Set shW = Sheets("作業") zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 If zz = 1 Then MsgBox "データが抽出されていません" Exit Sub End If fPath = ThisWorkbook.Path & "¥" '12_05_28_単品 fName = Format(CDate(shW.Range("B2").Value), "yy""_""mm""_""dd") & "_" & DataID & ".xlsx" newFlag = 0 If Len(Dir(fPath & fName)) > 0 Then 'ブックが存在する If MsgBox("すでに" & fName & "が存在します。既存ブックに追加しますか?", vbYesNo) = vbYes Then Set wb = Workbooks.Open(fPath & fName) Else newFlag = 1 End If Else newFlag = 2 End If z = z ¥ 50 If zz Mod 50 > 0 Then z = z + 1 For i = 1 To z If Not flag And newFlag <> 0 Then shG.Copy Set wb = ActiveWorkbook If newFlag = 2 Then wb.SaveAs fPath & fName flag = True Else shG.Copy After:=wb.Sheets(Sheets.Count) End If Set shD = ActiveSheet x = (i - 1) * 50 + 2 With shD .Range("C3").Value = shW.Range("B2").Value .Range("I3").Value = shW.Range("C2").Value .Range("G6").Value = shW.Range("D2").Value .Range("C9:L58").Value = shW.Cells(x, "F").Resize(50, 10).Value .Range("L60").Value = "P." & i 'ページ番号 場所は適切なところを指定 .Name = getSheetName(wb, CStr(i)) End With Next If newFlag <> 1 Then Application.DisplayAlerts = False wb.SaveAs fPath & fName Application.DisplayAlerts = True End If Application.ScreenUpdating = True MsgBox "伝票ブックを作成しました" End Sub (ぶらっと) ---- ぶらっと様 ありがとうございます。 ご指示いただいたコードを実行したところ、 「次の機能はマクロなしのブックに保存できません .VBプロジェクト これらの機能が含まれるファイルを保存する場合は「いいえ」をクリックし「ファイルの種類」ボックスでマクロ有効ファイルの種類を選択してください マクロなしのブックとして保存する場合は「はい」をクリックしてください」 というメッセージが出て、「はい」「いいえ」どちらをクリックしても 「マクロなしのブックにはVBプロジェクトやXMLを保存できません」 の実行時エラーが出ます。 fName = Format(CDate(shW.Range("B2").Value), "yy""_""mm""_""dd") & "_" & DataID & ".xlsx" を fName = Format(CDate(shW.Range("B2").Value), "yy""_""mm""_""dd") & "_" & DataID & ".xlsm" にしてみましたがやはりだめでした。 一応「Book1」というブックが作成されますが、中にはデータは抽出されていません。 （にょろ） ---- 不思議だねぇ。こちらには2007の環境がないので、2007ではどうなるかの確認ができないんだけど 2010では全く問題なく動いている。今も、新規の場合、既存ブックがあり、上書きの場合、既存ブックがあり新規作成の場合を実行。 いずれも、問題なく終了。 からっぽのブックになるというところも、今のところ、原因が全く思い当たらない。 こちらでも、引き続き、いろいろやってみるけど。 エラーになったとき、VBE画面のプロジェクトエクスプローラで、この新規ブックが、どうなっているか 標準モジュールなんかがついているのか? また、絵プロジェクトエクスプローラのシートやワークブックをクリックして、そこにマクロが何か存在するのか 確認してくれる? 追記）もう1つ。エラーになった後、デバッグではなく終了で終わらせて、できている新規ブックを手作業で、 できとうな名前の xlsx ファイルとして保存するとどうなるか教えて。 (ぶらっと) ---- ↑でいったようなことなんだけど、もしかしたらエクセルの設定にこちらと、そちらで何か違いがあるのかもしれない。 念のためのファイルフォーマットを付加してみてくれる? 2ヶ所ある SaveAs を If newFlag = 2 Then wb.SaveAs fPath & fName,xlOpenXMLWorkbook wb.SaveAs fPath & fName,xlOpenXMLWorkbook (拡張子は xlsx。ちなみに xlsm にするなら xlOpenXMLWorkbookMacroEnabled） (ぶらっと) ---- ぶらっと様 すみません、「マクロが〜」で保存できない現象の原因がわかりました。 雛形の「原紙 単品」「原紙 抱合せ」のシートモジュールに特定の列にカーソルを置いたら自動的に次の行に カーソルが移動するマクロが書かれていました （前任の方のを引き継いだばかりで気づきませんでした） それで、ファイルフォーマットを追加し、 >xlsm にするなら xlOpenXMLWorkbookMacroEnabled これを記述したところ伝票ファイルが作成されました。 更にそこに次の伝票シートがファイルに追加されるテストをしていたのですが、抽出されるデータが1行しかない場合、 「データが抽出されていません」 のエラーが出ます（「作業」シートにデータは抽出されています） もう1行データを追加すると正常に抽出・伝票シートが作成されます。 それで If zz = 0 Then '←ここを zz = 1 から zz = 0 に変えました MsgBox "データが抽出されていません" Exit Sub End If 上記部分を変更しましたが不都合はないでしょうか ※追加 作成する伝票のデータが50行以上ある場合は2ページ目以降に〜ということでしたが、 今テストすると50行までしか伝票が作成されず、2ページ目ができません… （作業シートには57行のデータが抽出されています） ※すみません、もう1件追加です 例えば「120530_単品_1便_通常」のシートを作成（ユーザーフォームに作成する伝票の条件を入力） した後、作成された伝票ブックの方がアクティブブックになるので、一度ユーザーフォームを 閉じなければなりません。 （引き続き「120530_単品_2便_通常」をユーザーフォームで選択すると「インデックスが有効範囲にありません」のエラー） それで、下記の部分を追加しましたが問題ないでしょうか? Dim filename As String '★追加 Application.ScreenUpdating = False filename = ActiveWorkbook.Name '★追加 プロシージャの最後 Workbooks(filename).Activate End Sub ※元のデータブックの名前が定期的に変わる為変数にしました （にょろ） ---- xlOpenXMLWorkbookMacroEnabled の件、了解。 比較行数の件、ごめん、ごめん。最初は z の値がタイトル行も含めたものにしていて、その時の名残。 z を取得する際にすでに -1 を追加してコードアップしたことを忘れていた。 そちらの変更でOKです。 追加された57行の場合の件、これは、 作成したブック名が、まったく新規ブック?それとも、既存ブックに対するシート追加? それとも、既存ブックはあるけど、新規で作成指示? どのケースだった?（まぁ、こちらでも確かめてみるけど） 追加の追加の件、ちょっと、困っているイメージがわからないんだけど、たぶん、処理後に伝票ブックを閉じないまま 次の伝票作成処理を実行したんだよね。 その場合、私のコードに手抜きがある。 そちらで手当てした方法は、あまり感心しない。 むしろ、現在の If DataID = "単品" Then Set shG = Sheets("原紙 単品") Else Set shG = Sheets("原紙 抱合せ") End If これを If DataID = "単品" Then Set shG = ThisWorkbook.Sheets("原紙 単品") Else Set shG = ThisWorkbook.Sheets("原紙 抱合せ") End If こうすべきかな? ついでに。 集計表のスペック、まだ見えないところもあるんだけど、いずれアップしたものを試してもらって こちらが誤解しているところがあれば、やりとりして直していけばいいと、そう思うけど、1点だけ。 商品の総計行を追加して、個数（総個数）を表示するレイアウト、あまり感心しない。 コード的には、それが1行なら、総計行を追加しないほうがいいとか、いや、それでも追加するとか、 スペックを確定させるときに悩んだり、また、コード自体も煩雑になるということも、さることながら できあがりの集計表をデータとして見たとき（あるいは、そこから関数やVBAで、二次利用しようとしたとき） 通常のデータ行なのか、追加された架空のデータ行なのかの判別をしなきゃいけなくなる。 むしろ、架空の行の追加はやめて、指定日ごとにわかれた行の最初の行だけにD列記載。 こうしたほうが、何かと利用しやすいと思うんだけど、どうだろうか? (ぶらっと) ---- >追加された57行の場合の件、これは、 >作成したブック名が、まったく新規ブック?それとも、既存ブックに対するシート追加? >それとも、既存ブックはあるけど、新規で作成指示? それぞれ試しましたが全部50行までしかできませんでした。 If DataID = "単品" Then Set shG = ThisWorkbook.Sheets("原紙 単品") Else Set shG = ThisWorkbook.Sheets("原紙 抱合せ") End If すみません、これも試しましたが伝票ブックの方がアクティブになってしまい「インデックスが〜」のエラーになります >むしろ、架空の行の追加はやめて、指定日ごとにわかれた行の最初の行だけにD列記載。 指定日毎の数量がはっきりわかれば、それでかまいません F列をなくしてD列に指定日なし&指定日別の個数を記載するということですよね? （にょろ） ---- レス遅れごめん。 >これも試しましたが伝票ブックの方がアクティブになってしまい「インデックスが〜」のエラーになります 伝票ブックがアクティブでもセットできるように THisWorkbook. をつけたんだけど、その後の Set shW = Sheets("作業") ここにもつけなきゃいけなかった。 Set shW = ThisWorkbook.Sheets("作業") にかえて試してみてくれる? >F列をなくしてD列に指定日なし&指定日別の個数を記載するということですよね? そうじゃなく、どちらかを、総計、どちらかを個別の数にしようということ。 で、総計は、最初の行にだけ記載、個別の数は全部の行に記載するという案。 (ぶらっと) ---- 以前、こちらのちょんぼで作成されるべきページが作成されなかったことがあったよね。 で、とりあえず、そちらで、手を加えたようだけど、そのあと、こちらからリバイス版をあっぷしているので 以下のようなところがあると思う。 zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 If zz = 1 Then MsgBox "データが抽出されていません" Exit Sub End If z = z ¥ 50 If zz Mod 50 > 0 Then z = z + 1 この zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 にブレークポイントを設定してとまったら ステップ実行させながら zz や z の値がどうなるか、確認してくれない? (ぶらっと) ---- >Set shW = ThisWorkbook.Sheets("作業") にかえて試してみてくれる? やってみましたが変わりません… >そうじゃなく、どちらかを、総計、どちらかを個別の数にしようということ 了解いたしました。F列が総計、D列が個別の数にしようと思います。 zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 ←ここは zz = 2 If zz = 1 Then ← zz= 2 MsgBox "データが抽出されていません" Exit Sub End If z = z ¥ 50 ← z = 0 If zz Mod 50 > 0 Then z = z + 1 ← zz = 2、z = 1 ※ If zz = 0 Then の場合 zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 ← zz = 2 If zz = 1 Then ← zz = 2 MsgBox "データが抽出されていません" Exit Sub End If z = z ¥ 50 ← z = 0 If zz Mod 50 > 0 Then z = z + 1 ← zz = 2、z = 1 どちらでも z や zz の値は変わりませんでした。 （にょろ） ---- ※ If zz = 0 Then の場合 そうだったね。こちらが正しい。 で、その zz の値が 2 ということは作業シートのB列のデータ最終行が3行目だったということだよねぇ。 本当に作業シートのデータは57件? zz が 2 ならページは1ページで間違っていないんだけどね? (ぶらっと) ---- あ、すみません!57行のデータで試していませんでした… zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1 ← zz = 56 If zz = 1 Then ← zz = 56 MsgBox "データが抽出されていません" Exit Sub End If z = z ¥ 50 ← z = 0 If zz Mod 50 > 0 Then z = z + 1 ← zz = 56、z = 1 です。すみません （にょろ） ---- わぁわぁ!! ごめん。前に、z と zz をわけたとき1か所訂正忘れ。 z = z ¥ 50 これを z = zz ¥ 50 こうしてくれる?おそまつ。 (ぶらっと@懺悔) ---- [[20120606124906]] 長くなったので次立てました。 z = zz ¥ 50 これでできました!! （にょろ）... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201205/20120528114720.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97059 documents and 608315 words.
訪問者：