Results of 1 - 1 of about 71 for ExecuteExcel4Macro 閉じた｜開いて｜開かず (0.012 sec.)
executeexcel4macro (140), 閉じた (629), 開いて (4904), 開かず (263)
- [[20120601100318]]
- #score: 14119
- @digest: 3d0fee7eb754f62797737e7660813631
- @id: 59149
- @mdate: 2012-06-12T10:58:44Z
- @size: 14049
- @type: text/plain
- #keywords: 検品 (124661), 品結 (72681), 全検 (47522), 品集 (45438), fold (42895), 果¥" (42032), 良合 (39289), 数良 (38555), 品チ (28565), 計○○ (28554), 品不 (28448), team (26088), 品ブ (24510), 良品 (20417), 用. (18880), チー (17234), 計ブ (12751), ー作 (12020), make (10831), 不良 (10738), 総数 (8514), ム名 (7362), 計用 (7221), 製品 (6795), 集計 (6685), smallscroll (6484), 計結 (5236), ○○○ (5188), activewindow (5127), windows (5029), activate (4999), operation (4068)
- 『複数ブック、シートの特定のセル（行）
を別の1つのブックに集約』（まんぷく） Excel2007 Windows Vista ある製品の検品の日ごとの集計を行うため 検品チーム（A〜E）毎に集計をとっております。 1チームで1つのブック（ブック名は検品A.xls〜検品E.xls） で管理しており、その中に検品した製品毎に同じ雛形でシート別 （シート名は@〜I※10種類ある場合。日によって製品・数は違うが 番号と製品はチームで統一）で分けて管理しております。 1日の終わりに各チーム毎のPCで入力して貰った ブック（検品*.xls）を集めてデスクトップ上のデータ置き場フォルダに格納します。 デスクトップ上に集計.xlsという別のブックを用意して 中のシートに予め容易された集計ボタンなどを押したら 製品毎（シート名は対応した同じ@〜I）にシート別に分けて 各チームのブックの各シートにある総数・良品・各不良項目の合計値が 記入されているセル（行）の値のみを集計ブックの各製品毎のシートのセル（行）の 1番上からチーム毎に順番に貼り付けていくようなマクロは可能でしょうか? ---- 可能、不可能でと答えると、可能でしょうねぇ。 しかし、お聞きになりたいのは実際のコードなのかな?と思います。 まずはチームごとに統一してある表のフォーマットはどうなっているか? >各チームのブックの各シートにある総数・良品・各不良項目の合計値が 記入されているセル（行） ↑↑ここのセルは固定なのか、毎回変わるのか?など 集計ブックのフォーマットが決まっているかなど（A列は○○で、B列は△△で、） 掲載されたら分かり易いと思いますが。 (通行人) ---- 各シートのフォーマットは全て同じで合計値が入る行（セル）は固定です。 具体的には5チーム稼働（変動有り）で1日で4種類の製品検査の場合 ブック:検品A シート:@ 列C 列F 列G 列H 〜 列P 行36 総数 良品 不良合計 ○○○ 〜 ××× ブック:集計 シート:@ 列B 列C 列D 列E 〜 列L 行3 総数 良品 不良合計 ○○○ 〜 ××× 行4 総数 良品 不良合計 ○○○ 〜 ××× 行5 総数 良品 不良合計 ○○○ 〜 ××× 行6 総数 良品 不良合計 ○○○ 〜 ××× 行7 総数 良品 不良合計 ○○○ 〜 ××× でシートは4種類でCまでとなります。 集計シートの行と列は仮です。 あくまで全チームの製品毎の合計を集計したい考えです。 ---- 現状どのような様式なのか 集計した様式は を箇条書きか、現状シートイメージで説明すれば、イン、アウト が明確となり回答しやすいと思いますよ。 日ごとの検品報告であれば 上記の説明では、日にちの特定はどこで行っているの 検品報告ブック名 検品A.xls と有りますが、 検品A(06月01日).xls のようにブック名に月日がある方が検索しやすい 収納フォルダーが日別名であるなら別ですが。 複数ブックから集計ブックにまとめるに当たり ・製品別 ・検品チーム別 ・1カ月まとめ、チーム別、製品別 ・不良率 など現状行っている整理の全てを書かれたほうがよいです 通常最低限の要望を聞いて、ある程度出来上がると、これもついでに と希望を小出しにする例も有ります。 目で見て、どのような集計結果を希望しているのか、分かりやすく まとめていただけますか。 現状では、文字から結果を考えあぐねてしまいます。 他サイトですが、最近同様な投稿がありましたから参考まで http://officetanaka.com/patio/patio.cgi?mode=view&no=3297 （asami） ---- 分かり難い説明で申し訳ありません。 現状は各検品ブックの各製品シート毎の合計の値の行の所を コピーして集計ブックの各製品のシートに上から1行ずつペーストして 一番下の行で合計が出るようにしてます。 5チームで10製品あるとすれば50回コピー&ペーストを繰り返してます。 終わった後に集計120605.xlsという名前をつけて1日ごとに保存してます。 各検品ブックは、集計シートにコピーが終われば数値をクリアして 翌日にまたそこに入力シートとして使用してます。 50回コピー&ペーストしている部分を自動化出来ればと思い投稿いたしました。 ---- （まんぷく）さんの説明で、チームと各行との関連が理解できません、が 毎日コピーペーストを繰り返しているとの事 ならば、シート1の集計だけでよいですから、「マクロの記録」をして、 その内容を張り出してください、そうしますと、操作内容が理解できます。 そのマクロを編集して@〜Iシートまで展開すればよいわけですから。 「マクロの記録」の操作が分からないときは、「EXCEL マクロの記録」 で検索をかければ解説がたくさん出てきます。 （asami） ---- マクロ記録してみました。 順番に全検ブックA〜Eまで開けてシート1のデータを、集計のシート1に貼付。 製品が複数ある場合はシート2のデータを、集計のシート2に貼付となります。 実際は全検ブックの入力された数値をクリアしてから閉じる。となります。 Sub test() ' ' test Macro ' ' Selection.Copy Windows("集計用.xls").Activate Range("C1:I2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("全検A.xls").Activate ActiveWindow.SmallScroll Down:=25 Range("C36:P37").Select Application.CutCopyMode = False Selection.Copy Windows("集計用.xls").Activate Range("C5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=28 Range("C36:P37").Select Application.CutCopyMode = False Selection.Copy Windows("集計用.xls").Activate Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=28 Range("C36:P37").Select Application.CutCopyMode = False Selection.Copy Windows("集計用.xls").Activate Range("C9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=26 Range("C36:P37").Select Application.CutCopyMode = False Selection.Copy Windows("集計用.xls").Activate Range("C11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=24 Range("C36:P37").Select Application.CutCopyMode = False Selection.Copy Windows("集計用.xls").Activate Range("C13").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("全検A.xls").Activate ActiveWindow.Close Windows("全検B.xls").Activate ActiveWindow.Close Windows("全検C.xls").Activate ActiveWindow.Close Windows("全検D.xls").Activate ActiveWindow.Close Windows("全検E.xls").Activate ActiveWindow.Close End Sub ---- 確認 最初の説明と2回目の説明とで違いが有ります。 また、説明文とマクロ記録では元データ範囲とコピー先の範囲にも相違があります。 マクロ記録が最終集計と捕らえてよいのですか。 (asami) ---- 2通り試作しました 前提として下記作業をしてください @Dドライブにフォルダー作成 ”検品集計”:ここに”集計用.xls”を収納 その下に”検品結果”:ここに”全検A.xls”収納 ”集計用.xls”の標準モジュールに下記をコピペしてください シート1にボタンを1個作り、Com1 を呼び出してください ・”全検*”Bookを開いて検査結果データを転記する 起動しているので、集計後他のフォルダーへ異動可能 ・”全検*”Bookを開かず検査結果を集計する 処理速度は速いがデータ読み込みのみ その応用をお任せします、当方はこれにて (asami) 例1:検品ブックを開き集計 Sub Com1() Dim md As String md = Mid(Date, 6, 5) & "日" Ans = MsgBox(md & "集計開始", vbOKCancel, "実行の確認") If Ans = vbOK Then Application.ScreenUpdating = False ' 画面更新停止 Shnam_Get 検品集計 Application.ScreenUpdating = True ' 画面回復 End If End Sub Sub 検品集計() Dim Team() As String Dim i As Long, j As Long, k As Long Dim Bks Dim t As Long, s As Long Dim fold As String Dim Pat As String Dim Buf As String Dim md As String Bks = ActiveWorkbook.Name ' 主ファイル名 Pat = ActiveWorkbook.Path ' パス t = 5 ' 検品チーム数 s = 10 ' 検品結果シート数 fold = Pat & "¥" ' フォルダ名 ReDim Team(t, 2) md = Mid(Date, 6, 5) & "日" ' 月日 Mid(md, 3, 1) = "月" For i = 1 To s Worksheets(i).Range("C5:P14").ClearContents Worksheets(i).Range("A1").Value = md Next With Worksheets(1) ' チーム名、Book名 配列取得 For i = 1 To t Team(i, 1) = .Range("A" & i + 29).Value Team(i, 2) = Team(i, 1) & ".xls" Next i End With Windows(Bks).Activate Buf = Dir(fold & "検品結果¥*.xls") ' フォルダー内検品結果ファイルを取得 Do While Buf <> "" For k = 1 To t ' Book名にチーム名が有るか If InStr(Buf, Team(k, 1)) > 0 Then ' チーム名有り Workbooks.Open Filename:=fold & "検品結果¥" & Buf Windows(Buf).Activate For i = 1 To s ' Book間シートコピー Application.Workbooks(Buf).Worksheets(i).Range("C36:P37").Copy _ Application.Workbooks(Bks).Worksheets(i).Range("C" & k * 2 + 3 & ":P" & k * 2 + 4) Next Windows(Buf).Activate ActiveWorkbook.SaveCopyAs fold & "検品結果¥" & md & Buf ' 集計済みフォルダヘ保存 ActiveWorkbook.Close Windows(Bks).Activate End If Next k Buf = Dir() Loop Windows(Bks).Activate For i = 1 To s Worksheets(i).Range("A2:P14").Borders.LineStyle = xlContinuous ' 罫線枠 Next ActiveWorkbook.SaveCopyAs fold & "集計結果¥" & md & Bks ' 集計済みフォルダヘ保存 End Sub Sub Shnam_Get() Dim s As Long, i As Long s = Worksheets.Count For i = 1 To s Range("B" & 29 + i) = Worksheets(i).Name Next End Sub Sub Fold_Up() ' 検品集計処理フォルダー作成 Dim d As String Dim m As String Dim y As String m = Mid(Date, 5, 2) ' 月 y = Mid(Date, 1, 4) ' 年 d = "D:¥検品集計 " ' フォルダ" Make_Fold Left(d, 7) ' 最初に主フォルダー作成 d = Left(d, 8) ' 下位フォルダー Make_Fold d & "¥検品済み" ' Make_Fold d & "¥集計結果" ' Make_Fold d & "¥集計結果¥" & m ' End Sub '================<< フォルダー作成 >>======= ' 機能説明 :有る:0 無い:1 Sub Make_Fold(d As String) Dim er As Long On Error GoTo ERTR ii: MkDir d ' D: Exit Sub ' 正常作成されれば ER=0 ERTR: '===============<< エラー処理 >>============== If Erl = ii Then ' エラー起こしたラベルがiiなら er = 1 ' フォルダー作成済みフラグ Resume Next ' 次の行へ復帰 End If End Sub ---- 例2:検品ブックを開かずに集計 Sub Com1() Dim md As String md = Mid(Date, 6, 5) & "日" Ans = MsgBox(md & "集計開始", vbOKCancel, "実行の確認") If Ans = vbOK Then Application.ScreenUpdating = False ' 画面更新停止 Shnam_Get 検品集計 Application.ScreenUpdating = True ' 画面回復 End If End Sub Sub 検品集計() Dim Team() As String Dim i As Long, j As Long Dim k As Long, x As Long, y As Long Dim Bks Dim t As Long, s As Long Dim fold As String Dim Pat As String Dim Buf As String Dim md As String Dim Sh() As String Bks = ActiveWorkbook.Name ' 主ファイル名 Pat = ActiveWorkbook.Path ' パス t = 5 ' 検品チーム数 s = 10 ' 検品結果シート数 fold = Pat & "¥" ' フォルダ名 ReDim Team(t, 2) ReDim Sh(s) md = Mid(Date, 6, 5) & "日" ' 月日 Mid(md, 3, 1) = "月" For i = 1 To s Worksheets(i).Range("C5:P14").ClearContents Worksheets(i).Range("A2:P14").Borders.LineStyle = xlContinuous ' 罫線枠 Worksheets(i).Range("A1").Value = md Sh(i) = Worksheets(1).Range("B" & i + 29).Value Next With Worksheets(1) ' チーム名、Book名 配列取得 For i = 1 To t Team(i, 1) = .Range("A" & i + 29).Value Team(i, 2) = Team(i, 1) & ".xls" Next i End With Windows(Bks).Activate Buf = Dir(fold & "検品結果¥*.xls") ' フォルダー内検品結果ファイルを取得 Do While Buf <> "" For k = 1 To t ' Book名にチーム名が有るか If InStr(Buf, Team(k, 1)) > 0 Then ' チーム名有り For i = 1 To s With Worksheets(i) For y = 0 To 1 ' 売上データコピー For x = 3 To 16 .Cells(k * 2 + y + 3, x).Value = ExecuteExcel4Macro("'" & fold & "検品結果¥" & "[" & Buf & "]" & Sh(i) & "'!R" & 36 + y & "C" & x) Next Next End With Next End If Next k Buf = Dir() Loop Windows(Bks).Activate For i = 1 To t ' 検品チームBook 起動 ' Workbook.Close Filename:=Team(i, 2) Next i End Sub Sub Shnam_Get() Dim s As Long, i As Long s = Worksheets.Count For i = 1 To s Range("B" & 29 + i) = Worksheets(i).Name Next End Sub Sub Fold_Up() ' 検品集計処理フォルダー作成 Dim d As String Dim m As String Dim y As String m = Mid(Date, 5, 2) ' 月 y = Mid(Date, 1, 4) ' 年 d = "D:¥検品集計 " ' フォルダ" Make_Fold Left(d, 7) ' 最初に主フォルダー作成 d = Left(d, 8) ' 下位フォルダー Make_Fold d & "¥検品済み" ' Make_Fold d & "¥集計結果" ' Make_Fold d & "¥集計結果¥" & m ' End Sub '================<< フォルダー作成 >>======= ' 機能説明 :有る:0 無い:1 Sub Make_Fold(d As String) Dim er As Long On Error GoTo ERTR ii: MkDir d ' D: Exit Sub ' 正常作成されれば ER=0 ERTR: '===============<< エラー処理 >>============== If Erl = ii Then ' エラー起こしたラベルがiiなら er = 1 ' フォルダー作成済みフラグ Resume Next ' 次の行へ復帰 End If End Sub (asami)
... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201206/20120601100318.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97056 documents and 608292 words.
訪問者：