[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロを使ったブックの複写方法』（さや）
すみません。マクロのことを教えてください。
Sub master変更(X As Integer)
f = Workbooks(2).FullName
f2 = Workbooks(2).Path
Workbooks(2).Save
Workbooks(2).Close
For g = X To 12
If (Len(g) = 1) Then
月 = "0" & g
Else
月 = g
End If
fnm2 = f2 & "\" & 年 & "\" & 月 & ".xls"
Workbooks.Open (fnm2)
Workbooks(1).Activate
M複写2 (2)
Workbooks(2).Save
Workbooks(2).Close
Next
For g = 1 To 12
If (Len(g) = 1) Then
月 = "0" & g
Else
月 = g
End If
fnm2 = ActiveWorkbook.Path & "\H" & "\" & 月 & ".xls"
Workbooks.Open (fnm2)
Workbooks(1).Activate
M複写2 (2)
Workbooks(2).Save
Workbooks(2).Close
Next
Workbooks.Open (f)
End Sub
上記のようなマクロのコードがあるのですが、データなどを入力する元々の
ブックを開いている状態で、データ保存されているブックを開き、入力後次
の月のブックに入力したデータを複写したいときには、上記のコード以外に
別のコードを追加したほうがいいのか？それとも上記のコードを多少変更し
てコードの書き換えを行ったほうがよろしいのでしょうか？
すみませんが教えてください。お願いします。
後関係があるので、下記のコードも載せておきます。
Sub M複写2(X As Integer)
Sheets("master").Select
Rows("2:31").Select
Selection.Copy
Workbooks(2).Activate
Sheets("master").Select
Rows("2:31").Select
ActiveSheet.Paste
Workbooks(2).Activate
Sheets("master").Select
End Sub
結構危険なマクロですね。 操作に使用する以外のファイルが開いていると、いろいろと誤動作しそうな 感じがしますが。
まずは、マクロだけでなくやりたい内容をもう少し言葉で説明してはどうで しょうか。
「master変更」自体他から呼ばれる処理のようですし、「入力後次の月の」 という部分も断片的で全体の処理がよく見えないように思います。 (Mook)
すみません。言葉足らずでした。 ここのコードのみを出したのは、このマスタ変更処理を行っているのがモジュール内の この部分に各場所飛ぶようにコードを作っていた為この部分だけを載せたのですが、 詳しい？説明になるかどうか分からないのですが、フォルダー名を"年"ブック名を01〜12 のデータ保存用のブックが12個あります。で、このマスターの変更を行うときが例えば、 今月の09月なら09のブックをデータを読み込めるようにはなっているのですが、その月の 分のデータならそのままの状態でフォームを閉じたときに保存になってくれます。できる なら、同じデータ入力後フォームを閉じる時にそのまま次に月にデータをコピーして保存 してくれるといいのですが・・・ このマクロを作ってくれて方はそのようになっていたらしいのですがフォームを閉じる時 に次の月のブックは開いてくれず、複写のされずそのまま閉じてしまいます。 すみません。上手く説明できてないような感じですが・・・どうかなる方法あるなら教え てください。お願いします。 (さや)
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If (henkou <> 0) Then
Y = MsgBox("変更処理が行われました。" & Chr(10) & "来月からのマスターも変更しますか？", vbYesNo)
If (Y = 6) Then
マスター変更 = (Month(日付))
End If
End If
If (fnm <> "") Then
M複写2 (2)
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
End Sub
追加コードです。
これがマスターフォームの中の変更コードです。
(さや)
説明いただいてだいぶ状況がわかってきましたが、もう少し確認させてください。 下記のマスタファイルの挙動をもう少し知りたいのですが、 >で、このマスターの変更を行うときが例えば、 >今月の09月なら09のブックをデータを読み込めるようにはなっているのですが、 編集時に、09のブックが開かれて、それをマスタファイルのフォームで変更 するという仕様なのでしょうか。
>その月の分のデータならそのままの状態でフォームを閉じたときに保存に >なってくれます。 ここは、問題ないのですよね？
>できるなら、同じデータ入力後フォームを閉じる時にそのまま次に月にデータ >をコピーして保存してくれるといいのですが・・・ 次の月の処理をするというのならわかるのですが、 「月にデータをコピーして保存。」 というのは何のデータを、どこに（月にというのは9月？10月？）でしょうか。
今一つ全体像が分からないのですが、マスタファイルで編集するデータが、 何か月にもわたっているので月ごとではなく、続けて処理できるようにしたい、 というようなことでしょうか。 (Mook)
細かく分かりやすい質問ありがとうございます。1つ1つできるだけ答えたいと思います。 >今月の09月なら09のブックをデータを読み込めるようにはなっているのですが、 編集時に、09のブックが開かれて、それをマスタファイルのフォームで変更 するという仕様なのでしょうか。 >そのとおりです。09月なら09月のデータを読み込み、09月のぶんの編集・入力を行う フォームがマスタフォームです。 >その月の分のデータならそのままの状態でフォームを閉じたときに保存に >なってくれます。 ここは、問題ないのですよね？ >ここは、問題ないです。 次の月の処理をするというのならわかるのですが、 「月にデータをコピーして保存。」 というのは何のデータを、どこに（月にというのは9月？10月？）でしょうか。 >例えば、09月の編集・入力が終わってその09月の情報をそのまま10月のデータに反映 するような形式にしたいのです。 >今一つ全体像が分からないのですが、マスタファイルで編集するデータが、 何か月にもわたっているので月ごとではなく、続けて処理できるようにしたい、 というようなことでしょうか。 >現在でも、一応編集したい月や年を決定するリストボックスがフォームの中にあるので 続けて次の月の編集ということもできるのですが、09月の編集後にフォームを閉じると そのまま次の10月に入力情報を複写していく。または、12月のデータを入力後フォーム を閉じると次の年の01月に情報を複写することをフォームを閉じる時に自動でできたら 今の現状より入力する項目も減り効率も上がるため、入力しかできない方の為にも役に 立つと考えていろいろとは試してみたんですが、なかなか成果が上がらないため学校で の相談となりました。よろしくお願いします。 (さや)
人違いだったら済みませんがサラサラさんとは別の方でしょうか。 > の使い方が似ていたので気になったのですが、下記の下の方をご参照ください。 [[20110918221701]]
さて本題ですが、最初のコードを見てみると master変更 は指定した月から12月のファイルまでの「master」シートにすべて 同じ内容をコピーしているように見えますが、これを年をまたいでコピーした いということでしょうか。 であれば、どこまで（何か月先）までコピーすればよいのでしょうか。 あるいはいつでも翌月だけでよいのですか？
蛇足ですが、 Sub M複写2(X As Integer) のなかで X が使われていないようですが、これは関係ありません？ (Mook)
すみません。サラサラさんとは別人です。 どこまでコピーをしたらいいのかという質問ですが、基本次の月にのみコピーできればいいです。 私の表現の仕方が悪かったみたいで・・・簡単に？いうとどの月になっても翌月にコピーできれば それでいいです。ただ、12月から翌年の01月になるときにそれなりのコードが必要なのかな？と疑 問が私自身にあったので分かり難い説明になったかと思います。 あと、Ｘの件ですが、たぶんほかのコードの中で所々出ていたので月のことかと思います。 すみません。よくは分かりません。よろしくお願いします。 (さや)
大体やりたいことは見えてきましたが、 master変更 を呼び出している部分のコードは提示できないでしょうか。 Workbooks(2) を対象と決めつけて操作していますが、非常に危険な香りがします。 この操作中に、他の EXCEL ファイルを開いていたりしたら、おかしなことになると 思いますが、それは大丈夫なのでしょうか。
とりあえず、推測の範囲での変更です。現在 master変更 X （X の部分は推測） と呼び出しているところを下記のように変更してみて、 master変更3 年, X (年 の部分は推測） 翌月のファイルが更新されるでしょうか。 現在のコードもそうですが、ファイルがない場合はエラーになるので、 そのあたり期待する動作かどうかは、確認ください。
−−−− 下記を追加
Sub master変更3(yy As Long, mm As Long)
Dim nextMonth
nextMonth = DateSerial(yy, mm + 1, 1)
M複写3 Workbooks(2).Path & Format(nextMonth, "\YYYY\MM") & ".xls"
M複写3 ThisWorkbook.Path & "\H\" & Format(nextMonth, "\MM") & ".xls"
End Sub
Sub M複写3(dstFilePath)
With Workbooks.Open(dstFilePath)
Workbooks(1).Sheets("master").Rows("2:31").Copy _
Destination:=.Sheets("master").Rows("2:31")
.Save
.Close
End With
End Sub
−−−− ここまで
やはりこのような処理は、一部だけを見て全体の挙動を整合させるのは非常に 難しいです。 関係するところはできるだけ全体を提示するか、細かいところまで仕様の 説明できないでしょうか。 (Mook)
すみません。返事が遅れました。 やはり全体をお見せして相談しないと難しいし、失礼ですよね。 上記のコード試してみたのですが・・・エラーにはならないものの動いてはくれませんでした。 下記以外のマスターフォームのコードは入力のもののみでしたので下記の分とモジュールのコード です。 たぶん、データ移動時に何かコードが抜けてしまったと思うのですが・・どうしたらよいのでしょう か？
Private Sub UserForm_Initialize()
henkou = 0
For f = 0 To 10
If (f = 0) Then
扶養.AddItem ""
Else
扶養.AddItem f
End If
Next
For Each e In Worksheets("雇用保険").Range("a2:a10000")
If (e = "") Then
Exit For
End If
給与額.AddItem e
Next
作業員.SelectedItem.Caption = Worksheets("master").Range("b2")
For c = 2 To 100
If (Worksheets("master").Cells(c, 2) = "") Then
Exit For
End If
作業員.Tabs.Add
作業員.Value = c - 2
作業員.SelectedItem.Caption = Worksheets("master").Cells(c, 2)
Next
作業員.Value = 0
If (fnm <> "") Then
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
日付.Value = Now()
If (Len(Month(日付)) = 1) Then
月 = 0 & Month(日付)
Else
月 = Month(日付)
End If
fnm = ActiveWorkbook.Path & "\H" & Year(日付) - 1988 & "\" & 月 & ".xls"
Workbooks.Open (fnm)
Workbooks(1).Activate
M複写 (2)
If (日付.Month = 1) Then
q = MsgBox("年度始めです。" & Chr(13) & "前年度で退職された人の削除処理を行って下さい。", vbOKOnly)
End If
End Sub
Private Sub 日付_NewMonth()
日付.Day = 2
日付.Day = 1
If (fnm <> "") Then
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
g = 日付
g = Year(g)
g = "H" & g - 1988
If (Len(Month(日付)) = 1) Then
k = "0" & Month(日付)
Else
k = Month(日付)
End If
fnm = ActiveWorkbook.Path & "\" & g & "\" & k & ".xls"
Workbooks.Open (fnm)
Workbooks(1).Activate
M複写 (2)
End Sub
Private Sub 日付_NewYear()
日付.Day = 2
日付.Day = 1
If (fnm <> "") Then
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
g = 日付
g = Year(g)
g = "H" & g - 1988
If (Len(Month(日付)) = 1) Then
k = "0" & Month(日付)
Else
k = Month(日付)
End If
fnm = ActiveWorkbook.Path & "\" & g & "\" & k & ".xls"
Workbooks.Open (fnm)
Workbooks(1).Activate
M複写 (2)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If (henkou <> 0) Then
Y = MsgBox("変更処理が行われました。" & Chr(10) & "来月からのマスターも変更しますか？", vbYesNo)
If (Y = 6) Then
マスター変更 = (Month(日付))
End If
End If
If (fnm <> "") Then
M複写3 (2)
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
End Sub
Private Sub 追加_Click()
作業員.Tabs.Add
作業員.Value = 作業員.Value + 1
Do
Y = InputBox("作業員名を入力して下さい。", "作業員登録")
If (Y <> "") Then
作業員.SelectedItem.Caption = Y
For c = 2 To 100
If (Worksheets("作業員").Cells(c, 1) = "") Then
Worksheets("作業員").Cells(c, 1) = Y
Exit For
End If
Next
For c = 2 To 100
If (Worksheets("master").Cells(c, 2) = "") Then
Worksheets("master").Cells(c, 2) = Y
M複写2 (2)
マスター変更 = (Month(日付))
Exit For
End If
Next
End If
Loop
End Sub
Private Sub 削除_Click()
If (日付.Month <> 1) Then
i = MsgBox("作業員の削除は、その年の１月のみ行って下さい。", vbOKOnly, "マスター削除")
Exit Sub
End If
i = MsgBox(作業員.SelectedItem.Caption & "のデータを削除しますか？", vbYesNo, "マスター削除")
If (i = 7) Then
Exit Sub
End If
削除処理 (作業員.Value + 2)
作業員.Tabs.Remove (作業員.Value)
End Sub
Private Sub 作業員_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim Y As Variant
作業員.Tabs.Add
作業員.Value = 作業員.Value + 1
Do
Y = InputBox("作業員名を入力して下さい。", "作業員登録")
If (Y <> "") Then
作業員.SelectedItem.Caption = Y
For c = 2 To 100
If (Worksheets("master").Cells(c, 2) = "") Then
Worksheets("master").Cells(c, 2) = Y
Exit For
End If
Next
Exit Do
End If
Loop
End Sub
ここまでが、マスターのコードで下記がモジュールのコードとなります。
Sub M複写(X As Integer)
Workbooks(X).Activate
Sheets("master").Select
Rows("2:31").Select
Selection.Copy
Workbooks(1).Activate
Sheets("master").Select
Rows("2:31").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End Sub
Sub M複写2(X As Integer)
Sheets("master").Select
Rows("2:31").Select
Selection.Copy
Workbooks(1).Activate
Sheets("master").Select
Rows("2:31").Select
ActiveSheet.Paste
Workbooks(1).Activate
Sheets("master").Select
End Sub
Sub M複写3(X As Integer)
Sheets("master").Select
Rows("2:31").Select
Selection.Copy
Workbooks(2).Activate
Sheets("master").Select
Rows("2:31").Select
ActiveSheet.Paste
Workbooks(2).Activate
Sheets("master").Select
End Sub
Sub master変更(X As Integer)
f = Workbooks(2).FullName
f2 = Workbooks(2).Path
Workbooks(2).Save
Workbooks(2).Close
For g = X To 12
If (Len(g) = 1) Then
月 = "0" & g
Else
月 = g
End If
fnm2 = f2 & "\" & 年 & "\" & 月 & ".xls"
Workbooks.Open (fnm2)
Workbooks(1).Activate
M複写3 (2)
Workbooks(2).Save
Workbooks(2).Close
Next
For g = 1 To 12
If (Len(g) = 1) Then
月 = "0" & g
Else
月 = g
End If
fnm2 = ActiveWorkbook.Path & "\H" & "\" & 月 & ".xls"
Workbooks.Open (fnm2)
Workbooks(1).Activate
M複写3 (2)
Workbooks(2).Save
Workbooks(2).Close
Next
Workbooks.Open (f)
End Sub
この来月へのコピーさえ上手くいけば他にエラーは出ないし、他の時分計算なども出来
ているので問題ないとは思うのですが・・・なんとかお願いします。
ここで入っていないとすれば、作業員のコードだとは思うのですが、マスターでは、
直接入力などはなく削除のみなのでこれ以上長いのも大変かな？と思い添付していませ
ん。
(さや)
全体を見る前に気になったのですがこの処理を行うときには、 「この EXCEL ファイル１つだけを開いた状態で実行するように」 というような制約がありませんか。
Workbooks(1)、 Workbooks(2) などは特定のExcel を指すのではなく、たまたま今開いて いる EXCEL ファイルの中で最初に開いたもの、2番目に開いたものという意味ですので、 他のファイルを開いた状態で動かすと、期待通りの動作にならないと思います。
この点は、今回の問題と直接関係無いとは思いますが、現状のままでよいのでしょうか。 (Mook)
実際には、マクロのフォームが画面全体に出ていて仮に他のExcelを開いていたとしても使用できないため このExcelを利用するときには、このExcelのみしか開きません。あとは、マクロによってデータが入って いる各ブックが開くという感じです。 実際には、このマクロを作った人がいれば問題はないのですが、現在居ないもので連絡もなかなかなので 私自身、マクロを少しいじれる程度しか知識がないものですからこれから後どうしたらいいものか分から ないのです。知恵をお貸しくださいお願いします。 (さや)
まだ隠れている部分が気になりますが、通常使う状態で
Sub BookCheck()
MsgBox ThisWorkbook.Name & vbNewLine & Workbooks(1).Name
End Sub
を実行して、同じであることを確認いただけますか。
Workbook(2) に関しても、きちんとファイルを指定する形に修正せば、他にいくら EXCEL
ファイルを開いていても互いに干渉することなく動作できるようになると思います。
そのためには、提示されていない部分に ファイルを開く（Open）をしている部分がない かが問題ですが、その確認はできますか。
それとも、他の部分は現状のままで、対象の部分だけの修正をご希望ですか。 であれば、基本は前回の回答と同じ内容になりますが。 (Mook)
ちょっとだけお邪魔します
これで全部だとすれば、まず正常に動かないですね。 モジュールレベルかPublicの変数定義が見当たらないです。 fnmやらgなどの変数はプロシージャレベルの変数ではないはずなので。
変数定義がどっかにあったとして、開いたブックのパスがfnmやfnm2ですよね？ であれば、まずは
Workbooks(1) → ThisWorkbook Workbooks(2) → Workbooks(Dir(fnm)) または Workbooks(Dir(fnm2))
のように修正する事から始めた方が良さそうですね。
他にもWorksheetオブジェクトの親がどのブックなのか明示されていなく Activateだけに頼っているのでMookさんの仰るように、 正しく動いている事自体が奇跡みたいなコードになってます。
（ｍｏｍｏ）
すみません。対象の部分の修正をお願いしたいのですが、以前のコードは追加して試し てみたのですが、マクロの動作自体に変化が見られませんでした。エラーもないし、 コピーはしてくれなかったです。私の追加の仕方が悪かったせいかも？と思いいろんな ところに追加してみたのですが、動作には変化がありませんでした。出来ればどこにど ういう風に追加するのか教えてもらえるとうれしいです。 momoさんの言っているコードは、 Public wj, wf, skey, ekey, jcnt, gkey, wkey As Integer Public wh As Double Public 作業tbl(30, 20), fnm, henkou, flg, 日計tbl(19, 5) As Variant Public 時間, 残業, 早出, 標準, 深夜, 休残業, 休早出, 休標準, 休深夜 As Double Public wrkymd As Date このコード？のことですかね？全部見てみましたが、このコードしか見当たらなかった です。 あと、このコードも必要ですか？ Sub Macro2() ' ' Macro2 Macro ' マクロ記録日 : 2007/4/16 ユーザー名 : sakae '
'
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Administrator\My Documents\管理ソフト\Book1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub
とりあえず、
Workbooks(1) → ThisWorkbook
Workbooks(2) → Workbooks(Dir(fnm)) または Workbooks(Dir(fnm2))
を頑張ってみます。
(さや)
Private Sub CommandButton1_Click()
Dim sp, xx As Variant
Dim jtbl(30) As Variant
f2 = 1
f3 = 1
X = 0
For Each e In Worksheets("作業員").Range("a1:a1000")
If (e = "") Then
Exit For
End If
X = X + 1
Next
If (指定.Value = True) Then
f = 0
For Y = 1 To 100
With Assistant.NewBalloon
.Heading = "作業員選択"
.Text = "作業員を選択してください。"
If (Y < X Or Y = X) Then
.CheckBoxes(1).Text = Worksheets("作業員").Cells(Y, 1)
Else
.CheckBoxes(1).Text = "作業員なし"
End If
If (Y + 1 < X Or Y + 1 = X) Then
.CheckBoxes(2).Text = Worksheets("作業員").Cells(Y + 1, 1)
Else
.CheckBoxes(2).Text = "作業員なし"
End If
If (Y + 2 < X Or Y + 2 = X) Then
.CheckBoxes(3).Text = Worksheets("作業員").Cells(Y + 2, 1)
Else
.CheckBoxes(3).Text = "作業員なし"
End If
If (Y + 3 < X Or Y + 3 = X) Then
.CheckBoxes(4).Text = Worksheets("作業員").Cells(Y + 3, 1)
Else
.CheckBoxes(4).Text = "作業員なし"
End If
If (Y + 4 < X Or Y + 4 = X) Then
.CheckBoxes(5).Text = Worksheets("作業員").Cells(Y + 4, 1)
Else
.CheckBoxes(5).Text = "作業員なし"
End If
.Button = msoButtonSetOK
.Show
If .CheckBoxes(1).Checked Then
jtbl(f) = Worksheets("作業員").Cells(Y, 1)
f = f + 1
End If
If .CheckBoxes(2).Checked Then
jtbl(f) = Worksheets("作業員").Cells(Y + 1, 1)
f = f + 1
End If
If .CheckBoxes(3).Checked Then
jtbl(f) = Worksheets("作業員").Cells(Y + 2, 1)
f = f + 1
End If
If .CheckBoxes(4).Checked Then
jtbl(f) = Worksheets("作業員").Cells(Y + 3, 1)
f = f + 1
End If
If .CheckBoxes(5).Checked Then
jtbl(f) = Worksheets("作業員").Cells(Y + 4, 1)
f = f + 1
End If
End With
Y = Y + 4
Application.Assistant.Visible = False
If (Y > X - 1) Then
Exit For
End If
Next
End If
For Each Y In Worksheets("作業員").Range("a1:a1000")
Worksheets("抽出").Range("a1:bb1000") = ""
If (Y = "") Then
Exit For
End If
If (指定.Value = True) Then
For X = 0 To 30
If (jtbl(X) = "") Then
gflg = 0
Exit For
End If
If (Y = jtbl(X)) Then
gflg = 1
Exit For
End If
Next
Else
gflg = 1
End If
If (gflg = 0) Then
GoTo 次
End If
f = 1
f2 = 1
For Each e In Workbooks(3).Sheets("ﾃﾞｰﾀｰ").Range("a1:a10000")
If (e = "") Then
Exit For
End If
If (Day(e) > 15 And Workbooks(3).Sheets("ﾃﾞｰﾀｰ").Cells(f, 2) = Y) Then
For t = 1 To 50
Worksheets("抽出").Cells(f2, t) = Workbooks(3).Sheets("ﾃﾞｰﾀｰ").Cells(f, t)
Next
f2 = f2 + 1
End If
f = f + 1
Next
f = 1
For Each e In Workbooks(2).Sheets("ﾃﾞｰﾀｰ").Range("a1:a10000")
If (e = "") Then
Exit For
End If
If (Day(e) < 16 And Workbooks(2).Sheets("ﾃﾞｰﾀｰ").Cells(f, 2) = Y) Then
For t = 1 To 50
Worksheets("抽出").Cells(f2, t) = Workbooks(2).Sheets("ﾃﾞｰﾀｰ").Cells(f, t)
Next
f2 = f2 + 1
End If
f = f + 1
Next
If (Worksheets("抽出").Range("a1") <> "") Then
早出 = 0
標準 = 0
残業 = 0
深夜 = 0
休早出 = 0
休標準 = 0
休残業 = 0
休深夜 = 0
For t = 1 To 100
If (Worksheets("抽出").Cells(t, 1) = "") Then
Exit For
End If
残業計算 (t)
Next
日 = Fix(標準 / 8)
平時 = ((標準 / 8) - Fix(標準 / 8)) * 8
休日 = Fix(休標準 / 8)
休時 = ((休標準 / 8) - Fix(休標準 / 8)) * 8
t = 3
For Each q In Worksheets("master").Range("b3:b100")
If (q = Y) Then
Exit For
End If
t = t + 1
Next
If (日 < 22 And t <> 3) Then
For ll = 日 To 22
If (休日 = 0 And 休時 = 0 And 休早出 = 0 And 休残業 = 0 And 休深夜 = 0) Then
Exit For
End If
If (休日 = 0) Then
残業 = 残業
休残業 = 休残業
早出 = 早出
休早出 = 休早出
深夜 = 深夜
休深夜 = 休深夜
平時 = 平時
休時 = 休時
日 = 日 + Fix(平時 / 8)
平時 = ((平時 / 8) - Fix(平時 / 8)) * 8
Else
日 = 日
休日 = 休日
End If
Next
End If
'If (全員.Value = True) Then
Worksheets("支給").Cells(2, 1) = 1
'End If
l = 2
For Each q In Worksheets("支給").Range("a2:a100")
If (q = "") Then
Exit For
End If
l = l + 1
Next
Worksheets("支給").Cells(l, 1) = Worksheets("master").Cells(t, 1)
If (Worksheets("master").Cells(t, 3) <> "") Then
Worksheets("支給").Cells(l, 5) = 残業
Worksheets("支給").Cells(l, 6) = 早出
Worksheets("支給").Cells(l, 7) = 深夜
Worksheets("支給").Cells(l, 8) = 休日
Worksheets("支給").Cells(l, 9) = 休時
Worksheets("支給").Cells(l, 10) = 休残業
Worksheets("支給").Cells(l, 11) = 休早出
Worksheets("支給").Cells(l, 12) = 休深夜
Else
Worksheets("支給").Cells(l, 3) = 日
Worksheets("支給").Cells(l, 4) = 平時
Worksheets("支給").Cells(l, 5) = 残業
Worksheets("支給").Cells(l, 6) = 早出
Worksheets("支給").Cells(l, 7) = 深夜
Worksheets("支給").Cells(l, 8) = 休日
Worksheets("支給").Cells(l, 9) = 休時
Worksheets("支給").Cells(l, 10) = 休残業
Worksheets("支給").Cells(l, 11) = 休早出
Worksheets("支給").Cells(l, 12) = 休深夜
Select Case Worksheets("支給").Range("x1")
Case 1, "1"
If (Worksheets("支給").Cells(l, 1) = 5 Or Worksheets("支給").Cells(l, 1) = "5") Then
Worksheets("支給").Cells(l, 24) = 10000
End If
Case 2, "2"
If (Worksheets("支給").Cells(l, 1) = 5 Or Worksheets("支給").Cells(l, 1) = "5") Then
Worksheets("支給").Cells(l, 24) = 5000
End If
Case Else
If (Worksheets("支給").Cells(l, 1) = 5 Or Worksheets("支給").Cells(l, 1) = "5") Then
Worksheets("支給").Cells(l, 24) = ""
End If
End Select
End If
End If
次:
f3 = f3 + 1
Next
Y = MsgBox("給与台帳を印刷しますか？", vbOKCancel, "印刷判定")
If (Y = 1) Then
Worksheets("台帳").PageSetup.CenterHeader = "&18" & "平成" & Right(年, 2) & "年 " & 月 & "月分 " & "給与明細表"
Worksheets("台帳").PrintOut
End If
xx = 1
Worksheets("社員控").Range("b3") = "平成" & Right(年, 2) & "年" & 月 & "月分"
If (Worksheets("社員控").Range("z3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("at3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("bn3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("ch3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("db3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("dv3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("ep3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("fj3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("gd3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("gx3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("hr3") <> "") Then
xx = xx + 1
If (Worksheets("社員控").Range("il3") <> "") Then
xx = xx + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
sp = 1
Y = MsgBox("社員明細を印刷しますか？", vbOKCancel, "印刷判定")
If (Y = 1) Then
Worksheets("社員控").PrintOut sp, xx
End If
pnm = Application.ActivePrinter
Y = MsgBox("給与封筒を印刷しますか？", vbOKCancel, "印刷判定")
If (Y = 1) Then
Application.ActivePrinter = "EPSON PM-A820 on Ne10:"
For Each e In Worksheets("台帳").Range("a2:a31")
If (e = "") Then
Exit For
End If
Y = MsgBox(e & "さんの封筒を印刷しますか？", vbOKCancel, "印刷判定")
If (Y = 1) Then
Worksheets("封筒").Range("a15") = e & " 殿"
Worksheets("封筒").PrintOut
End If
Next
Application.ActivePrinter = pnm
End If
Y = MsgBox("社員明細を表示しますか？", vbOKCancel, "表示判定")
If (Y = 1) Then
明細表示.Show
End If
Worksheets("支給").Range("a2:a31") = ""
Worksheets("支給").Range("c2:l31") = ""
Worksheets("支給").Range("x2:x51") = ""
Unload 給与
End Sub
このコードのWorkbooks(2)やWorkbooks(3)もWorkbooks(Dir(fnm)) または Workbooks(Dir(fnm2))
またはWorkbooks(Dir(fnm3))見たいな感じでいいのですか？ここでは、fnmが見当たらないので
とりあえず、そのままにしています。
今のところ他のところは編集中です。
(さや)
ひやぁ、すごいコードですね。 動くとは思いますが、思い切り手を入れたくなるコードですｗ。
対応は闇雲にやるのではなく、変更する内容を理解しながらやった方がよいかと思います。 まずは変数を全体できちんと宣言するところからはじめてはどうでしょうか。
Option Explicit （変数宣言を必須にする）の使用をお勧めします。 (Mook)
>思い切り手を入れたくなるコードですｗ。 同感ですねぇ 簡単なコードをい〜っぱい組み合わせて書いてあるのと オブジェクトの階層やプロパティを無視して書いているので とても読みにくいです。
ちょっと手入れしてみようかしら、と思ったのですが コントロールが何なのかわからずで断念・・・
仕様を書いてもらって作りなおしたほうが早そうな気もしてきます。 （ｍｏｍｏ）
え！？そんなにひどいコードだったんですか？ >Option Explicit （変数宣言を必須にする）の使用ってどういうふうにしようするのですか？ Public wj, wf, skey, ekey, jcnt, gkey, wkey As Integer Public wh As Double Public 作業tbl(30, 20), fnm, henkou, flg, 日計tbl(19, 5) As Variant Public 時間, 残業, 早出, 標準, 深夜, 休残業, 休早出, 休標準, 休深夜 As Double Public wrkymd As Date ここのどこかに追加して書き込むのですか？ すみません。お手数かけますが教えてください。 それともやはりあきらめたほうがいいんですかね。そんなにひどいコードだとは思いませんでしたの で・・・。すみません。何も分からなくて迷惑ばかりかけているかんじですね。 (さや)
迷惑じゃないですよ。 やる気のある質問者さんは大歓迎です。
今はまだどうするのがいいかを確認している段階です。 じれったく感じるかもしれませんが、それが結局は早道だと思います。
Option Explicit は各モジュールの先頭に書いてください。 動かそうとすると、変数が定義されていません。 っていうエラーが出ますから、それを各プロシージャに書くことになります。
上記のように Public で宣言されているものは、モジュール間で共通して 使用できますが、動作時に何が設定されているか把握しずらいので必要最小限 の利用にとどめておいた方が良いと思います。 あるプロシージャだけでしか使わないものは、そのプロシージャで宣言すれば よいですし、呼び出し側で受け渡して使うものは、引数にする方が良い場合 が多いです。
学校って答えを求めるところではなく、考え方や答えの出し方を学ぶところ だと思います。 小麦（問題）はパン（答えだけ）にしてしまえば一回の食事ですが、種にして 育てられれば（考え方を学べれば）豊かで楽しい生活につながると思います。 この考え方に賛同いただける限りは、いくらでもお付き合いしますよ。 (Mook)
あ〜私の書き方がちょっと悪かったですね。 すみません。
プログラミングも成長過程があって、徐々に理解していけばよいので 今のコードが変だからあきらめるなんてもったいないです。 むしろ、良い材料があるのですから学んでいきましょう。
頼もしいMook先生が付いていますので安心して1歩づつ解決してください。 （ｍｏｍｏ）
いやいや私としては、ｍｏｍｏさんの活躍を見込んで大風呂敷を広げています。
さやさん、どういうようにもっていったらいいかというのを考えならが、まずは 最初の質問部分である「次月への反映」を進めましょうか。 目に見える成果がないとモチベーションが続かないということもあると思いますので。
基本コードは提示したとおりですが、呼び出す側で変更が必要ですが、その部分が 分からないのかなぁと推測しています。 また後ほど（あるいはｍｏｍｏさんがもっといい方法を）、そのあたりを提示したいと 思います。 (Mook)
本来なら全体を直したいところですが、あまりにも状態に依存しすぎていて、 部分的に手を入れるのが難しいです。
最初に立ち戻って、 [master変更(X As Interger)] の処理でやりたいのは、 翌月のファイルへマスタファイルの内容をコピーするだけでよいのでしょうか。
提示のコードにはこの処理を呼び出している部分がないので、X に何が指定
されているかわかりませんが、X〜12月までを
C:\あるフォルダ\2011\10.xls
の形式のファイルにコピー。
そのあとにマスターファイルと同じフォルダに 1〜12月までを
C:\このフォルダ\H\10.xls
のようにコピーしているように見えます。
これを翌月にする場合、上記は西暦を表すフォルダを更新する必要があります が、後半の処理は年を指定するフォルダがないので、今年の1月を次年の1月が上書き してしまいますが、それは問題ないですか。
それから、「年」、「月」の変数の宣言が見当たらなく、これがどのように 管理されているか、やはり不明ですので「年」は適当な値が入っていると 仮定します。 一応、仮定を積み重ねた例なので、実際と整合しないかもしれませんが、 指定された年月の翌月を更新する例です。 （翌年のフォルダがない場合はエラーになるので、作成しておいてください。）
下記を master変更 と同じモジュールに置き、現在の呼び出し部分を master変更 (X) から master変更2 年, X のように変更してみてください。 プロシージャを呼び出す部分の () は本来必要ないので、外しています。
'-------------------------------------------------------------------
Sub master変更2(yy As Integer, mm As Integer)
'-------------------------------------------------------------------
Dim dstPath As String
dstPath = Workbooks(2).Path
Dim nextMonth
nextMonth = DateSerial(yy, mm + 1, 1)
With Workbooks.Open(dstPath & Format(nextMonth, "\YYYY\MM") & ".xls")
ThisWorkbook.Sheets("master").Rows("2:31").Copy .Sheets("master").Rows("2:31")
.Save
.Close
End With
With Workbooks.Open(ThisWorkbook.Path & "\H\" & Format(nextMonth, "\MM") & ".xls")
ThisWorkbook.Sheets("master").Rows("2:31").Copy .Sheets("master").Rows("2:31")
.Save
.Close
End With
End Sub
上記は Workbooks(2) のように依存をしないので、そのファイルを開いたままで 他のファイルを処理しています。
元の処理は Workbooks(2) を対象とするために、処理前に開いていたファイル を閉じて、最後に又開くということをしていますが、これも状態依存の弊害 ですね。
それから、最初の方で追加したという Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) は内部で M複写3 は呼び出しています。
M複写3 は前に Workbooks(1)(=ThisWorkbook?) がアクティブなことを前提に しており、他の呼び出し部分は呼び出し前にこれを Activate していますが、 上記ではその処理がありません。
これでいつでも正しく動くかどうかは不明ですが、このようにステータスを 常に使用側（コード記述者＆ファイル使用者）が意識しないといけないのも、 現在のコードの問題です。 (Mook)
Private Sub UserForm_Initialize()
henkou = 0
For f = 0 To 10
If (f = 0) Then
扶養.AddItem ""
Else
扶養.AddItem f
End If
Next
For Each e In Worksheets("雇用保険").Range("a2:a10000")
If (e = "") Then
Exit For
End If
給与額.AddItem e
Next
作業員.SelectedItem.Caption = Worksheets("master").Range("b2")
For c = 2 To 100
If (Worksheets("master").Cells(c, 2) = "") Then
Exit For
End If
作業員.Tabs.Add
作業員.Value = c - 2
作業員.SelectedItem.Caption = Worksheets("master").Cells(c, 2)
Next
作業員.Value = 0
If (fnm <> "") Then
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
日付.Value = Now()
If (Len(Month(日付)) = 1) Then
月 = 0 & Month(日付)
Else
月 = Month(日付)
End If
fnm = ActiveWorkbook.Path & "\H" & Year(日付) - 1988 & "\" & 月 & ".xls"
Workbooks.Open (fnm)
Workbooks(1).Activate
M複写 (2)
If (日付.Month = 1) Then
q = MsgBox("年度始めです。" & Chr(13) & "前年度で退職された人の削除処理を行って下さい。", vbOKOnly)
End If
End Sub
Private Sub 日付_NewMonth()
日付.Day = 2
日付.Day = 1
If (fnm <> "") Then
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
g = 日付
g = Year(g)
g = "H" & g - 1988
If (Len(Month(日付)) = 1) Then
k = "0" & Month(日付)
Else
k = Month(日付)
End If
fnm = ActiveWorkbook.Path & "\" & g & "\" & k & ".xls"
Workbooks.Open (fnm)
Workbooks(1).Activate
M複写 (2)
End Sub
Private Sub 日付_NewYear()
日付.Day = 2
日付.Day = 1
If (fnm <> "") Then
Workbooks(2).Save
Workbooks(2).Close
fnm = ""
End If
g = 日付
g = Year(g)
g = "H" & g - 1988
If (Len(Month(日付)) = 1) Then
k = "0" & Month(日付)
Else
k = Month(日付)
End If
fnm = ActiveWorkbook.Path & "\" & g & "\" & k & ".xls"
Workbooks.Open (fnm)
Workbooks(1).Activate
M複写 (2)
End Sub
返事が遅れてすみません。
もしかして、年や月の指定をしているコードはこのコードのことですか？
あと、>今年の1月を次年の1月が上書きしてしまいます
は、できれば前年の1月のデータはそのまま残しておきたいのですが・・・
今回、いろいろと迷惑かけながら勉強していますが、何となくではありますが、
少しずつMOOKさんやmomoさんが教えてくれたことが分かってきました。
すみませんが、もう少しつきあってもらえませんか？お願いします。
(さや)
うーん、今回定時の中にも master変更 を呼び出している部分も年の定義も無いですね。
ただ提示の中で Hの謎（平成のHだったんですね）は解けましたので、そこの重複 は無くなると思います。 呼び出す部分はこちらではなんともなりませんので、検索等で探し出すしかないですね。 マクロの中でも文字検索はできますので、検索範囲をカレントプロジェクトにして、 master変更 や 年 を検索してみて下さい。
どこで値を代入して、どこで呼び出しているかがわかると思います。 年のように大域変数を使うと中の値をあちこちで設定したり参照したりするので、 きちんと管理して使わないと、後の保守が大変になります。
さて、このあたり適当な例題ですから、修正をご自身でトライしてみませんか。
最初に提示されたものは
fnm2 = ActiveWorkbook.Path & "\H" & "\" & 月 & ".xls"
Workbooks.Open (fnm2)
でしたので、下記のように変更しました。
With Workbooks.Open(ThisWorkbook.Path & "\H\" & Format(nextMonth, "\MM") & ".xls")
今回提示されたのは
fnm = ActiveWorkbook.Path & "\H" & Year(日付) - 1988 & "\" & 月 & ".xls"
Workbooks.Open (fnm)
ですから、 UserForm_Initialize と master変更 では違うものを見てしまっているようですね。
"\H" & Year(日付) - 1988 & "\" & 月
のぶぶんん (例：H2\310）は
Format(日付,"ge\\mm")
とも書けます。このあたり EXCEL の Text 関数と同じ挙動なので利用できるといいですね。
元のままでも良いですし Format を使っても良いですから master変更2 を年対応に変更して 見て下さい。 (Mook)
MOOKさん、momoさんありがとうございました。 このマクロを作った方がたまたま来てコピーする部分など直してくれました。 見ていて意味が分かりませんでした・・・ また、時間があるときにでもゆっくりと何が変わったのか確認したいと思います。 たぶん、時間的にあまりかかっていないし、マスターフォームしかつかんでいなかったので マクロ的に危ないのかもしれないと思うのですが・・・今のところデバックでないし、スムーズ に動いているのでとりあえず現状でいこうと思います。 また、分からないところも出ると思いますがその時には今回同様細かく教えてください。 よろしくお願いします。 (さや)
内容を理解しておらず機能変更などの保守もできないものを業務で使用しているって、 こわくないですか？
まぁ、さやさんがそれをすべきポジションにいるかどうかは分かりませんが、その作成した 方でも良いですし誰かしらが、今回のような要望に対応できるような体制があるのが健全な 状況かと思います。
もしさやさんが、運用の管理的立場にいるのであったり、今後もマクロを業務で使って いかれるのであれば、こういう余裕のあるときにこそ、内容を理解できる 程度にいろいろ と見ておいた方が良いのではないでしょうか。
いざ何かあったときには、作った人がやめてしまっていて何も分からない、というような 状況は良く聞く話です。 老婆心ながら、まだ作成された方に聞ける状況のうちに、中身を理解しておいた方が良い と思いますよ。 (Mook)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.