自動でマクロファイルにデータを入力し保存したい

質問

何時も、大変お世話になっております。
私の能力では、解決出来ず大変困っています。
稼働率や共用率、その他の値を計算してくれるExcelのマクロファイルに、機器毎にデータを入力し、計算が終わるとこのマクロファイルを別名で保存する作業を毎回手作業で行っています。
機器は250個程あり、大変な手間が掛かってしまいます。
また、手作業で別名でファイルを保存する為、入力ミスが生じでしまいます。
この作業を自動化したいのですが、やり方が全く分からず困っています。もし、自動化のやり方をご存じでしたら、ご教示をお願いいたします。
・データファイルは下記のようなフォーマットになっています。
・セルA2～セルAOの範囲の装置分のデータを、マクロファイルの入力用シート『カテゴリーログ』のセルA4から値張り付けで入力します。
・出力ファイル名は、『ステーション_グループ_装置ID_装置名.xlsx』としたいです

装置ID 装置名 ステーション グループ 利用日 開始時間 終了時間 利用時間 利用形態 ユーザーID 利用者 所属区分 所属機関 利用区分 提供AM 課題ID 課題名 利用係数 単価 内容消耗品 数量 実費物件費合計 単価 役職 数量 実費人件費合計 標準単価 適用単価 数量 共用設備等使用料合計 基準額 役職 "技術代行
係数" 単価 数量 合計 小計 間接経費 税抜き合計 消費税相当額 合計 単合税込 備考欄1 備考欄2 備考欄3
AB0016 AB6連装置 融合St 001F 2022/6/2 13:30 15:30 2 技術代行 500037 大谷 翔平 大企業 ソソ株式会社 NNF利用 22HH8041 GaN系プロセス 1 2000 CR料 2 4000 2 0 2 0 15000 研究、エン 2 30000 2 60000 64000 19200 83200 8320 91520
AB0019 化合物装置 融合St 001F 2022/6/2 12:00 13:00 1 機器利用 500174 吉田 知也 公的研究機関 A総合研究所 AAM利用 JPNM0003 シリフォト 0.3 2000 CR料 1 2000 1 0 1 0 15000 研究、エン 0 0 1 0 2000 0 2000 200 2200
AB0009 水蒸気装置 融合St 001F 2022/4/30 16:00 16:15 0.25 機器利用 500114 柏 翼 大学等 ABC大学 AAM利用 JPNM0009 Si熱電集積 0.3 2000 CR料 0.25 500 0.25 0 0.25 0 15000 研究、エン 0 0 0.25 0 500 0 500 50 550
AB0024 赤外線装置 融合St 001F 2022/4/30 16:15 17:00 0.75 機器利用 500172 高橋 正夫 大企業 ソレ株式会社 NNF利用 22HH8002 GaN系材料 1 2000 CR料 0.75 1500 0.75 0 0.75 0 15000 研究、エン 0 0 0.75 0 1500 450 1950 195 2145
AB0024 赤外線装置 融合St 001F 2022/6/30 15:15 16:15 1 機器利用 500172 高橋 正夫 大企業 ソレ株式会社 NNF利用 22HH8002 GaN系材料 1 2000 CR料 1 2000 1 0 1 0 15000 研究、エン 0 0 1 0 2000 600 2600 260 2860
AB0009 水蒸気装置 融合St 001F 2022/6/30 15:00 15:30 0.5 18913 河野 久機 装置管理 自主運用 0 0 CR料 0.5 0 0.5 0 0.5 0 15000 研究、エン 0 0 0.5 0 0 0 0 0 0
AB0030 顕微式測定 融合St 001F 2022/6/30 15:00 16:00 1 機器利用 500135 中前 秀一 大学等 BBB大学 NNF利用 22HH8046 半導体パルス 0.3 2000 CR料 1 2000 1 0 1 0 15000 研究、エン 0 0 1 0 2000 600 2600 260 2860
AB0018 多目的装置 融合St 001F 2022/5/30 14:45 15:30 0.75 機器利用 500071 清水 悦朗 大企業 セラ株式会社 NNF利用 22HH8014 フォト 1 2000 CR料 0.75 1500 0.75 0 0.75 0 15000 研究、エン 0 0 0.75 0 1500 450 1950 195 2145
AB0165 フェム装置 分析St 分析2 2022/5/30 9:00 17:00 8 装置管理 使用不可 0 8 0 8 0 8 0 0 8 0 0 0 0 0 0
AB0166 放電質分析 分析St 分析2 2022/6/8 9:00 0:00 15 10637 装置管理 NNMS 使用不可 メンテナンス 0 15 0 15 0 15 0 0 15 0 0 0 0 0 0
AB0166 グロー分析 分析St 分析2 2022/6/9 0:00 9:00 9 10637 装置管理 NNMS 使用不可 メンテナンス 0 9 0 9 0 9 0 0 9 0 0 0 0 0 0
AB0166 グロー分析 分析St 分析2 2022/6/9 9:30 11:30 2 技術代行 15986 高田 裕一 NNMS NNMS 内部利用 22HH5379 Ni基超の分析 0.1 2 0 2 0 2 0 15000 研究、エン 2 3000 2 6000 6000 0 6000 600 6600
AB0166 グロー分析 分析St 分析2 2022/6/9 13:30 15:30 2 技術代行 15986 高田 裕一 NNMS NNMS 内部利用 22HH5379 Ni基超の分析 0.1 2 0 2 0 2 0 15000 研究、エン 2 3000 2 6000 6000 0 6000 600 6600
AB0176 酸素22装置 分析St 分析2 2022/6/1 14:00 15:00 1 20546 装置管理 自主運用 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0
AB0169 簡易型粉末 分析St X回折 2022/5/8 11:30 13:30 2 機器利用 20458 田代 知美 NNMS スマート材料 内部利用 22HH5082 0.1 2 0 2 0 2 0 0 2 0 0 0 0 0 0
AB0169 簡易型粉末 分析St X回折 2022/5/8 13:40 15:40 2 機器利用 20729 直井 今子 NNMS 熱エネ材料 内部利用 22HH5176 0.1 2 0 2 0 2 0 0 2 0 0 0 0 0 0
AB0169 簡易型粉末 分析St X回折 2022/6/9 9:00 9:30 0.5 8101 上瀬 直美 NNMS 分析ステ 使用不可 メンテナンス 0.5 0 0.5 0 0.5 0 0.5 0 0 0 0 0 0
AB0169 簡易型粉末 分析St X回折 2022/6/13 14:00 15:30 1.5 機器利用 21015 タラチャンド NNMS 変換材料 内部利用 22HH5176 0.1 1.5 0 1.5 0 1.5 0 0 1.5 0 0 0 0 0 0
AB0081 X線光電子 融合St 002F 2022/4/2 9:30 10:00 0.5 技術代行 15659 李 ー勝 NNMS 内部利用 22HH5111 Two 0.1 0.5 0 0.5 0 0.5 0 15000 研究、エン 1.2 1800 0.5 900 900 0 900 90 990
AB0085 多連S装置 融合St 002F 2022/4/2 16:30 17:00 0.5 13109 装置管理 自主運用 0 0.5 0 0.5 0 0.5 0 0 0.5 0 0 0 0 0 0
AB0085 多連S装置 融合St 002F 2022/4/2 9:30 11:00 1.5 技術代行 18311 ロダ オマル NNMS 内部利用 22HH5034 人工シナプス 0.1 1.5 0 1.5 0 1.5 0 15000 研究、エン 1.2 1800 1.5 2700 2700 0 2700 270 2970
AB0095 SEM3装置 融合St 002F 2022/6/2 14:00 16:00 2 技術代行 17769 チェンフイ NNMS 内部利用 22HH5365 高次構造 0.1 2 0 2 0 2 0 15000 研究、エン 1.2 1800 2 3600 3600 0 360

回答No.36

kkkkkm · ベストアンサー

> 　装置の稼働率-共用率ファイル中に連番を付ける事は出来ませんでした。

連番ではなく
もし、「装置の稼働率-共用率_xxxxxx-xxxxxx.xlsx」にデータ転記後、A列、B列、C列のいずれかが「空白になる」可能性がある場合、データが上下デコボコに転記されてしまいます。

たとえばB列(グループ)に空白があった場合

A, B, C, D, E列
あ,い,う,え,お　1件目
か,空,く,け,こ　2件目
さ,し,す,せ,そ　3件目

上記のように転記されるのが本来ですが
空白があると下記のように転記されてしまいます。

A, B, C, D, E列
あ,い,う,え,お　1件目
か,し,く,け,こ　2件目
さ,空,す,せ,そ　3件目

> ST名 グループ 装置ID（資産番号）

上記がA列、B列、C列で空白になる可能性がないのでしたら変更しなくてもいけます。

先日「#DIV/0!」の件があったので、上記のセルで空白のセルが存在する可能性もあるのかなと思っての変更提案です。

連番は手作業でお願いします。

お礼

大変お世話になっております。
最終的な確認は一応完了しました。
この質問については、これで完了と致します。
今回の質問から困った事、分からない事が新たに発生した場合は、再度ご質問をさせて頂きますので、何卒よろしくお願い申し上げます。
最終までご教授下さり、本当にありがとうございました。

補足

大変お世話になっております。
更にかみ砕いたご教示ありがとうございました。

下記、理解しました。　連番は手作業で作成する事に致します。
『先日「#DIV/0!」の件があったので、上記のセルで空白のセルが存在する可能性もあるのかなと思っての変更提案です。』

では、回答35でご教示頂いたｽｸﾘﾌﾟﾄの箇所は、元へ戻した方がよろしいでしょうか？

回答No.37

kkkkkm

> では、回答35でご教示頂いたｽｸﾘﾌﾟﾄの箇所は、元へ戻した方がよろしいでしょうか？

既に変更しているようですから変更したままで大丈夫です。

お礼

大変お世話になっております。
早速のご教示ありがとうございました。

長期に渡り、大変分かり易くかみ砕いてご教授下さり、
心から感謝申し上げます。
マクロの余分なコメントを削除し、作成したデータについて、最終的な確認作業をしております。
多分、これで問題ないはずですが、『この質問の終了』をもう少しだけお待ちくださいませ。

回答No.35

kkkkkm

もし、「装置の稼働率-共用率_xxxxxx-xxxxxx.xlsx」にデータ転記後、A列、B列、C列のいずれかが「空白になる」可能性がある場合、データが上下デコボコに転記されてしまいます。

A列、B列、C列に「空白が現れない場合」は現状のままでいけます。

Sub TestLast()
の

'上から下記ｽｸﾘﾌﾟﾄをここへ移動する20220807
から
'20回に一度一時停止します。

の間

多分こうなっていると思います

FinalDataSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = ThisWorkbook.Sheets("Summary3").Range("A2").Value
FinalDataSheet.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Value = MSheet.Range("D5").Value
FinalDataSheet.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(1, Columns("AA").Column - 1).Value = _
ThisWorkbook.Sheets("Summary3").Range("B2:AA2").Value

上記の部分を

Dim WRow As Long
With FinalDataSheet
' 絶対空白が現れない列が存在する場合Aをその列にして
WRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1

.Cells(WRow, "A").Value = ThisWorkbook.Sheets("Summary3").Range("A2").Value
.Cells(WRow, "B").Value = MSheet.Range("D5").Value
.Cells(WRow, "C").Resize(1, Columns("AA").Column - 1).Value = _
ThisWorkbook.Sheets("Summary3").Range("B2:AA2").Value
End With

に変更してください。

絶対空白が現れない列をA列としています。
A列以外を指定したい場合は
Cells(Rows.Count, "A").End(xlUp).Row + 1
の"A"を変更してください。
指定した列が空白だった場合、その行のデータは次のデータに上書きされてしまします。

絶対空白が現れない列が不明な場合は以下に変更してください。

Dim WRow As Long
With FinalDataSheet

With .Range("A1").CurrentRegion
WRow = .Rows(.Rows.Count).Row + 1
End With

.Cells(WRow, "A").Value = ThisWorkbook.Sheets("Summary3").Range("A2").Value
.Cells(WRow, "B").Value = MSheet.Range("D5").Value
.Cells(WRow, "C").Resize(1, Columns("AA").Column - 1).Value = _
ThisWorkbook.Sheets("Summary3").Range("B2:AA2").Value
End With

補足

大変お世話になっております。

・装置の稼働率-共用率ファイルのA列(St名)の左側に、
　単純な連番の列を追加するについて、砕いた説明及びｽｸﾘﾌﾟﾄのご教示ありがとうございました。

『装置の稼働率-共用率ファイル』のA列、B列、C列に、
　絶対空白が現れない列が不明な場合を選択し、
ｽｸﾘﾌﾟﾄを以下のように修正し、マクロを起動しましたが、
　装置の稼働率-共用率ファイル中に連番を付ける事は出来ませんでした。

　複数箇所のｽｸﾘﾌﾟﾄ修正が必要とのご教示なので、これは修正の一部で、更に複数箇所の修正が必要になりますでしょうか？大変お手数でも、ご教示をよろしくお願いいたします。

　※因み、Summary3と装置の稼働率-共用率ファイルの項目は以下の通りになります。
＜下記はSummary3の項目＞
ST名 装置ID（資産番号） 装置名 装置稼働率 外部共用率 内部共用率 装置共用率 設備共用（日） 外部共用（日） 内部共用（日） 装置稼働（日） ARIM利用（件） NOF利用（件） 内部利用（件） 自主運用（件） ARIM利用（人） NOF利用（人） 内部利用（人） 自主運用（人） ARIM利用（実日数） NOF利用（実日数） 内部利用（実日数） 自主運用（実日数） ARIM利用（H） NOF利用（H） 内部利用（H） 自主運用（H）

＜下記は装置の稼働率-共用率ファイルの項目＞
ST名 グループ 装置ID（資産番号） 装置名 装置稼働率 外部共用率 内部共用率 装置共用率 設備共用（日） 外部共用（日） 内部共用（日） 装置稼働（日） ARIM利用（件） NOF利用（件） 内部利用（件） 自主運用（件） ARIM利用（人） NOF利用（人） 内部利用（人） 自主運用（人） ARIM利用（実日数） NOF利用（実日数） 内部利用（実日数） 自主運用（実日数） ARIM利用（H） NOF利用（H） 内部利用（H） 自主運用（H）

----以下はマクロで修正した箇所になります---------
DoEvents

'20220810 下記をコメントアウトして、下記を追加した、グループ名追加の為

'20220814 装置の稼働率-共用率_202204-202207.xlsxの左側へ連番を追加する為、下記ｽｸﾘﾌﾟﾄを変更する。

''上から下記ｽｸﾘﾌﾟﾄをここへ移動する20220807
'' FinalDataSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, Columns("AA").Column).Value = _
''ThisWorkbook.Sheets("Summary3").Range("A2:AA2").Value

''20220810　上記ｽｸﾘﾌﾟﾄを下記へ変更した、グループ名追加の為
'FinalDataSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = ThisWorkbook.Sheets("Summary3").Range("A2").Value
'FinalDataSheet.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Value = MSheet.Range("D5").Value
'FinalDataSheet.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(1, Columns("AA").Column - 1).Value = _
'ThisWorkbook.Sheets("Summary3").Range("B2:AA2").Value

'20220814 絶対空白が現れない列が不明の場合として下記をｽｸﾘﾌﾟﾄを追記した。
Dim WRow As Long
With FinalDataSheet

With .Range("A1").CurrentRegion
WRow = .Rows(.Rows.Count).Row + 1
End With

.Cells(WRow, "A").Value = ThisWorkbook.Sheets("Summary3").Range("A2").Value
.Cells(WRow, "B").Value = MSheet.Range("D5").Value
.Cells(WRow, "C").Resize(1, Columns("AA").Column - 1).Value = _
ThisWorkbook.Sheets("Summary3").Range("B2:AA2").Value
End With

'20220810　下記を無効にした。
''20回に一度一時停止します。
'If cnt Mod 20 = 0 Then
'MsgBox "一時停止中" & vbCrLf & vbCrLf & "Okで続行します", vbInformation
' End If

cnt = cnt + 1
Call M_Clear(MSheet)
End If
Next
End With

回答No.34

kkkkkm

> 修正箇所は、以下ですが、問題なかったでしょうか？

はい、それで問題ありません。

> 　連番を付ける為にファイルを挿入すると、連番の位置がずれると言う事でしょうか？

連番は正しく入ります。

現在はA列から右へデータを転記していますが、列挿入すると元のデータはB列からになります。
現時点では列挿入は最後になりますので問題はありません。

ただ、列挿入したファイルを保存して再度利用(既に同名ファイルがある場合そちらを開いて確認するようになっています)した場合、A列から転記しますので、項目名とデータが一致しなくなります。ファイルの再度利用はしないと思いますが、何があるか分からないので説明をしておきました。

それを考えなくていいように、最初にB列から右に転記しておき、転記時にA列に連番を入れていけばいいわけですが、その修正が数か所になりますということです。

回答No.33

kkkkkm

> ④については、説明不足で申し訳ありませんでした。
> 　肝心のファイル名が抜けていました。
> 　やりたい事は、Summary3の値が入った、装置の稼働率-共用率ファイルのA列(St名)の左側に、単純な連番の列を追加したいです。
コードの訂正箇所が多くなりますので手作業でやってください。
なお、挿入したファイルを利用してマクロを実行すると転記位置がずれます。

補足

大変お世話になっております。
ご教示ありがとうございました。

・下記の質問については、申し訳ありません。
　私の記載誤りがありまして、下記のｽｸﾘﾌﾟﾄのように修正しました。
　　②書式を数値の小数点第2位で表示可能であるか？
　　③J列～AC列の値を全て、整数(小数点ゼロ)で表示可能であるか？

　修正箇所は、以下ですが、問題なかったでしょうか？
　'20220813　下記の指定した列が誤りであった為修正した。
　 '.Columns("F:I").NumberFormatLocal = "0.00_ "
　 '.Columns("J:AC").NumberFormatLocal = "0_ "

　 .Columns("E:H").NumberFormatLocal = "0.00_ "
　 .Columns("I:AB").NumberFormatLocal = "0_ "

装置の稼働率-共用率_202204-202207.xlsx
　F列～I列　　　　(誤り)
　　　装置稼働率
　　　外部共用率
　　　内部共用率
　　　装置共用率

　　　E列～H列　　(正しい：こちらを小数点第2位にしたい)
　　　装置稼働率
　　　外部共用率
　　　内部共用率
　　　装置共用率

　　　J列～AC列　(誤り)

　　　I列～AB列　(正しい：こちらを整数(小数点ゼロ)にしたい)
　※ｽｸﾘﾌﾟﾄを修正後、再度マクロを起動して、装置の稼働率-共用率_202204-202207.xlsxの
　　結果を確認しました。
　　E列～H列は小数点第2、I列～AB列は整数(小数点ゼロ)の記載になりました。

・④の質問については、了解致しました。
　連番をつけるだけですので、手入力で問題ありません。

・ご教示頂いた、下記の意味ですが、
　連番を付ける為にファイルを挿入すると、連番の位置がずれると言う事でしょうか？
　すみません、愚鈍な私にはよく分かりませんでした。
　『なお、挿入したファイルを利用してマクロを実行すると転記位置がずれます。』

回答No.32

kkkkkm

> ④列の始まり(ST名の前)に、項目を『№』として、連番を付けられないか？　

とりあえず

共用部門装置IDのように塊ごとに並んでいて塊は同じ番号として塊ごとに連番とする場合
と
↓単に上から順に連番とする場合
の二通り
どちらか選択して「'」を外してください。
"D"を実際の列に変更してください。
「No」がいらない場合
「"No" &」を削除

最後の方に追加してください。

End With
↑これの下

Dim Fcnt As Long: Fcnt = 1
With FinalDataSheet
For i = 2 To .Cells(Rows.Count, "D").End(xlUp).Row

'↓共用部門装置IDのように塊ごとに並んでいて塊は同じ番号として塊ごとに連番とする場合
' If .Cells(i, "D").Value <> .Cells(i + 1, "D").Value Then
' .Cells(i, "D").Value = "No" & Fcnt & .Cells(i, "D")
' Fcnt = Fcnt + 1
' Else
' .Cells(i, "D").Value = "No" & Fcnt & .Cells(i, "D")
' End If
'↑塊ごとここまで

'↓単に上から順に連番とする場合
' .Cells(i, "D").Value = "No" & i - 1 & .Cells(i, "D")

Next
End With

↓これの上
Application.ScreenUpdating = True
Application.StatusBar = False 'ステータスバーの解除

回答No.31

kkkkkm

回答No.30の訂正

NewFile.Sheets(1).Name = NewSheetName
NewFile.Sheets(1).Range("A1").Value = ThisWorkbook.Sheets("Summary3").Range("A1").Value
NewFile.Sheets(1).Range("B1").Value = ThisWorkbook.Sheets("カテゴリーログ").Range("D4").Value
NewFile.Sheets(1).Range("C1:AB1").Value = ThisWorkbook.Sheets("Summary3").Range("B1:AA1").Value
NewFile.SaveAs NewFilePath

の最後の

NewFile.SaveAs NewFilePath

は除いて

NewFile.Sheets(1).Name = NewSheetName
NewFile.Sheets(1).Range("A1").Value = ThisWorkbook.Sheets("Summary3").Range("A1").Value
NewFile.Sheets(1).Range("B1").Value = ThisWorkbook.Sheets("カテゴリーログ").Range("D4").Value
NewFile.Sheets(1).Range("C1:AB1").Value = ThisWorkbook.Sheets("Summary3").Range("B1:AA1").Value

の部分を変更です。

補足

大変お世話になっております。
敏速なご教示ありがとうございました。kkkkkmさんは本当に流石凄い方ですね。

①『#DIV/0!』が入っているセルに半角の『-』を入力するように出来るか？

　　Summary3の式で0で除算をする可能性がある所がありますのでそこの式を直してください。
　　ご紹介頂いたURLを見て、下記のように関数式を変更して、割り算で割れなかった値には
『-』が記載されるようになりました。ありがとうございました。

　【外部共用率】
SUM(AH122:AI122)/SUM(AH122:AJ122)
　　　　↓
=IFERROR(SUM(AH122:AI122)/SUM(AH122:AJ122), "-")

【内部共用率】
=SUM(AJ122)/SUM(AH122:AJ122)
　　　　　　↓
=IFERROR(SUM(AJ122)/SUM(AH122:AJ122),"-")

【装置共用率】
=SUM(AH122:AJ122)/SUM(AH122:AK122)
　　　　　　↓
=IFERROR(SUM(AH122:AJ122)/SUM(AH122:AK122), "-")

④については、説明不足で申し訳ありませんでした。
　肝心のファイル名が抜けていました。
　やりたい事は、Summary3の値が入った、装置の稼働率-共用率ファイルのA列(St名)の左側に、単純な連番の列を追加したいです。

③の最後の
NewFile.SaveAs NewFilePath
は除いて
　ありがとうございました。回答30のｽｸﾘﾌﾟﾄ修正で、
『インデックスが有効範囲にありません』がでて迷っていました。今、マクロを稼働中です、結果は後程ご報告させて頂きます。

回答No.30

kkkkkm

> ①『#DIV/0!』が入っているセルに半角の『-』を入力するように出来るか？

Summary3の式で0で除算をする可能性がある所がありますのでそこの式を直してください。

https://www.cando.co.jp/column/column_13.html

> ②下記の書式を数値の小数点第2位で表示可能であるか？
> ③J列～AC列の値を全て、整数(小数点ゼロ)で表示可能であるか？

Function Make_File_Open(
の所にある

NewFile.Sheets(1).Name = NewSheetName
NewFile.Sheets(1).Range("A1").Value = ThisWorkbook.Sheets("Summary3").Range("A1").Value
NewFile.Sheets(1).Range("B1").Value = ThisWorkbook.Sheets("カテゴリーログ").Range("D4").Value
NewFile.Sheets(1).Range("C1:AB1").Value = ThisWorkbook.Sheets("Summary3").Range("B1:AA1").Value
NewFile.SaveAs NewFilePath

を以下に変更してください

With NewFile.Sheets(1)
.Name = NewSheetName
.Range("A1").Value = ThisWorkbook.Sheets("Summary3").Range("A1").Value
.Range("B1").Value = ThisWorkbook.Sheets("カテゴリーログ").Range("D4").Value
.Range("C1:AB1").Value = ThisWorkbook.Sheets("Summary3").Range("B1:AA1").Value
.Columns("F:I").NumberFormatLocal = "0.00_ "
.Columns("J:AC").NumberFormatLocal = "0_ "
End With

> ④列の始まり(ST名の前)に、項目を『№』として、連番を付けられないか？　

どこの事なのか具体的な列(A列とか)を示してください。何件目と出る件数が連番となっていいのでしょうか。
前というのはデータの前でABCDならNo1ABCDでいいとか具体例を示してください。

> 　　それとも、入力ファイルをスクリプトで装置毎に並べる動作をしてないのでしょうか？

Call M_Sort(DataWb)
で
Function M_Sort(
の所を呼び出して並び替えをしています。
並び替えをしているかどうかは、データを別の状態で並び替えてマクロを実行してみればわかると思います。

回答No.29

kkkkkm

> ②マクロを強制終了させたい時は、Ctrl　+　PauseBreakキーでよろしいでしょうか？

こちらのPCにPauseBreakが無いので確認はしていませんが、それでいいと思います。

> ③3つの装置名のファイルが保存できなかった件は、
> 　下記をマクロに入れましたが、前回と同事象でファイルを作成できませんでした。

'↓「-」に変更する場合
は、次の行の行頭の「'」を削除してその行を有効にしてください。

' NewBookName = Replace(NewBookName, BadStr(j), "-")

'↓全角に変更する場合
は、以下の行の行頭の「'」を削除してその行を有効にしてください。

' If BadStr(j) = "\" Then
' NewBookName = Replace(NewBookName, BadStr(j), "￥")
' ElseIf BadStr(j) = """" Then
' NewBookName = Replace(NewBookName, BadStr(j), "ー")
' Else
' NewBookName = Replace(NewBookName, BadStr(j), StrConv(BadStr(j), vbWide))
' End If

> 　今年の4月～来年の3月のデータだと、約6万行となりますが、今後、このマクロを使い続ける事は可能でしょうか？

14000行でいけたのでいけそうな気もしますが、こればかりは、何とも言えませんとしか言いようがないです。
マクロ内の件数としては「2,147,483,647件」まで行けるような設定にはしていますが、他の仕様と絡むとどうなるかは不明です。

繰り返し処理を長く続けるとエラーになる可能もあります。一応ならないようにちょっと手を入れてますが、それが6万行で有効かどうかは不明です。

> ⑥このマクロを起動させている時に、他のExcelのファイルを開きましたが、このマクロが完了後に表示されました。メモリーが足りてない為でしょうか？

メモリー不足ではなく、マクロを実行しているので、そちらが忙しくて手が回らない的な状態だと思います。

補足

大変お世話になっております。
それそれの質問について、ご教示ありがとうございました。 参考とさせて頂きます。

本日、再度マクロを起動させまして、ほったらかしでマクロは正常に終了出来ました。
出力ファイルも全て作成出来ました。稼働時間は60分間程度で完了しました。
本当にありがとうございました。
また、２）でご教示のお願いがあります、何度も申し訳ありません。

１）3つのファイルが作成されない件は、下記を有効にして、
　　作成する事が出来ました。ありがとうございました。

　 NewBookName = Replace(NewBookName, BadStr(j), "-")

２）昨夜から本日にかけて、提出用資料と作成頂いた、
　　装置の稼働率-共用率_202204-202207.xlsxの確認をしました。
　　提出用資料と比較すると、書式が違っておりや列の頭に連番が付いていました。
　　この辺りを良く確認してご教示をお願いすべきでした。

　　散々お世話になり、その上、五月雨式のお願いになり大変恐縮なのですが、可能でしたら、下記の①～④についてご教示を頂けたらと思います。
　　ややこしい事でしたら、手作業で作業出来ますので大丈夫です。

　　①『#DIV/0!』が入っているセルに半角の『-』を入力するように出来るか？

　　②下記の書式を数値の小数点第2位で表示可能であるか？
　　　F列～I列
　　　装置稼働率
　　　外部共用率
　　　内部共用率
　　　装置共用率

　　③J列～AC列の値を全て、整数(小数点ゼロ)で表示可能であるか？

　　④列の始まり(ST名の前)に、項目を『№』として、連番を付けられないか？　

３）マクロのｽｸﾘﾌﾟﾄを見ていて、入力ファイル(稼働率用データ.xlsx)の並べ替えをしている、
　　ｽｸﾘﾌﾟﾄが何処なのか分かりませんでした。
　　それとも、入力ファイルをスクリプトで装置毎に並べる動作をしてないのでしょうか？
　　すみません、つまらない疑問でした。

　　'20220810下記を追加
BadStr = Array("\", "/", ":", "*", "?", """", "<", ">", "|")

Set DataWb = Workbooks("稼働率用データ.xlsx")
Set MSheet = ThisWorkbook.Sheets("カテゴリーログ")
'装置の稼働率-共用率ファイルのフォルダを変更したい場合ThisWorkbook.Pathを変更する
FinalaDataTmp = Make_File_Open(ThisWorkbook.Path, DataWb)
Set FinalDataBook = Workbooks(Split(FinalaDataTmp, ",")(0))
Set FinalDataSheet = FinalDataBook.Sheets(Split(FinalaDataTmp, ",")(1))

Call M_Sort(DataWb)
Call M_Clear(MSheet)

'有効にすると画面の表示(コピペしている状態)を止めますので処理が早くなる
Application.ScreenUpdating = False

With DataWb.Worksheets("結合_OK").ListObjects("テーブル1")

'20220810　下記を変更した。
'IDCol = .ListColumns("共用部門装置ID").DataBodyRange.Column
'FRow = 2: cnt = 1

IDCol = .ListColumns("共用部門装置ID").DataBodyRange.Column
FRow = 2: cnt = 1: MaxCnt = 0 '←MaxCnt = 0 が増えてます
For i = 2 To .Range.Rows.Count
If .Range.Cells(i, IDCol).Value <> .Range.Cells(i + 1, IDCol).Value Then
MaxCnt = MaxCnt + 1
End If
Next

回答No.28

kkkkkm

> 『インデックスが有効範囲に有りません』が出力されてマクロを実行出来なくなりました。

どこで出たのか不明なのでよくわかりませんが、データファイルの仕様が変わったために「そんなところがない」というエラーだと思いますので、マクロで指定している名前のもの(テーブル名など)があるかどうか確認してください。

> マクロを実行すると、『MaxCnt = 0』の箇所で、
> 『変数が見つかりません』とエラーが出てしまいました。

Dim MaxCnt As Long
を最初の方のDimの塊の下に移動して

もしくは
Dim cnt As Long
を
Dim cnt As Long, MaxCnt As Long
に変更して

が、できていないのだと思います。

補足

大変お世話になっております。
ご教示ありがとうございました。
4月分～7月分の4か月の稼働率を出す事が出来ました。
データ数＝約14000行
今夜、更に稼働率の設定値が正しく設定出来ているかなどの確認へ入る予定でいます。

すみません、①～6について、ご報告とご質問をさせて頂きます。
①『インデックスが有効範囲に有りません』のエラーについては、
　データを追加した時にデータファイル名の拡張子をxlsxで保存した為と、データをテーブル形式で保存してなかった事が原因ではないかと思われます。
　マクロのスクリプトの中で、拡張子をxlsm→xlsxへ変更して、データをテーブル形式で保存したらマクロを実行する事が出来ました。

②マクロを強制終了させたい時は、Ctrl　+　PauseBreakキーでよろしいでしょうか？

③3つの装置名のファイルが保存できなかった件は、
　下記をマクロに入れましたが、前回と同事象でファイルを作成できませんでした。
　※こちらの事象についは、装置名3つだけなので手動で修正して問題ないです。
　　AB0041の装置名＝LC/MS/MS（Q-exe）
　　AB0077の装置名＝GC-3 (Sx, AN/HO)
　　AB0212の装置名＝FB/SM装置(Helios 650)

Dim BadStr As Variant, j As Long
をDimの塊の最後に追加して
BadStr = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
を
Set DataWb = Workbooks("稼働率用データ.xlsm")
の前に追加して
For j = LBound(BadStr) To UBound(BadStr)
'↓「-」に変更する場合
' NewBookName = Replace(NewBookName, BadStr(j), "-")
'↓全角に変更する場合
' If BadStr(j) = "\" Then
' NewBookName = Replace(NewBookName, BadStr(j), "￥")
' ElseIf BadStr(j) = """" Then
' NewBookName = Replace(NewBookName, BadStr(j), "ー")
' Else
' NewBookName = Replace(NewBookName, BadStr(j), StrConv(BadStr(j), vbWide))
' End If
Next
を
'マクロ無しのブックに保存できないというメッセージが一度出ますがOkしてください。
On Error Resume Next
の前に追加してください。

④マクロを実行すると、『MaxCnt = 0』の箇所で、『変数が見つかりません』とエラーが出た件は、
　ご教示の通りに変更した所、エラーは出なくなりました。有難うございました。

⑤稼働率を求める為のデータファイルは1月間で約5000行のデータが入ります。
　今年の4月～来年の3月のデータだと、約6万行となりますが、今後、このマクロを使い続ける事は可能でしょうか？最終的には、年度末に1年間の装置の稼働率を求める事になります。

⑥このマクロを起動させている時に、他のExcelのファイルを開きましたが、このマクロが完了後に表示されました。メモリーが足りてない為でしょうか？

回答No.27

kkkkkm

ステータスバーのMaxCntの値を正確に出したい場合には(共用部門装置IDのデータを一巡して件数を調べるので時間が余分にかかります)

Dim MaxCnt As Long
を最初の方のDimの塊の下に移動して

もしくは
Dim cnt As Long
を
Dim cnt As Long, MaxCnt As Long
に変更して

IDCol = .ListColumns("共用部門装置ID").DataBodyRange.Column
FRow = 2: cnt = 1

の所を

IDCol = .ListColumns("共用部門装置ID").DataBodyRange.Column
FRow = 2: cnt = 1: MaxCnt = 0 '←MaxCnt = 0 が増えてます
For i = 2 To .Range.Rows.Count
If .Range.Cells(i, IDCol).Value <> .Range.Cells(i + 1, IDCol).Value Then
MaxCnt = MaxCnt + 1
End If
Next

に追加変更してください。

元の

Dim MaxCnt As Long
MaxCnt = 216

はコメントにするか削除して下さい。

また

sStatus = "[ " & cnt & "件目 ]" & "　を処理中…"

を

sStatus = "[ " & cnt & " / " & MaxCnt & " 件目 ]" & "　を処理中…"

に変更すると

[ 進行中の件目 / 総件数　件目 ]　を処理中…

となります。

補足

大変お世話になっております。
マクロのご教示ありがとうございました。
・昨夜、4月分～6月分まで入っているデータファイルに、7月分を追加し、
マクロを実行したら、
『インデックスが有効範囲に有りません』が出力されてマクロを実行出来なくなりました。
再度、データファイルを稼働率用データ.xlsxとマクロ無しにしてみたり、しましたが、症状は変わりませんでした。
マクロファイルは、修正前のファイルを使用しても同じ症状でした。
すみませんが、原因・対処法がお分かりでしたら、ご教示をお願いいたします。

・又、マクロファイルをご教示頂いた下記に変更後、
マクロを実行すると、『MaxCnt = 0』の箇所で、
『変数が見つかりません』とエラーが出てしまいました。
これについても、原因・対処法がお分かりでしたら、ご教示をお願いいたします。

ステータスバーのMaxCntの値を正確に出したい場合には(共用部門装置IDのデータを一巡して件数を調べるので時間が余分にかかります)

Dim MaxCnt As Long
を最初の方のDimの塊の下に移動して

もしくは
Dim cnt As Long
を
Dim cnt As Long, MaxCnt As Long
に変更して

IDCol = .ListColumns("共用部門装置ID").DataBodyRange.Column
FRow = 2: cnt = 1

の所を

IDCol = .ListColumns("共用部門装置ID").DataBodyRange.Column
FRow = 2: cnt = 1: MaxCnt = 0 '←MaxCnt = 0 が増えてます
For i = 2 To .Range.Rows.Count
If .Range.Cells(i, IDCol).Value <> .Range.Cells(i + 1, IDCol).Value Then
MaxCnt = MaxCnt + 1
End If

Next

に追加変更してください。

元の

Dim MaxCnt As Long
MaxCnt = 216

はコメントにするか削除して下さい。