マクロでブックの作成

質問

A列にある氏名（約100人、毎月増えていきます）を読み取ってその氏名の名前の個人データのブックを次々と作成していくようなマクロはどの様にすればいいでしょうか？
個人データブックには個人の毎月の売り上げが記入できるようになっているので出来ればそのブックの中の氏名も同時に反映されてコピーされるといいのですが・・・・

そしてその氏名の後ろにC列の個人IDナンバーが付いてくるといいのですがかなり難度が高いのでお手上げ状態です。

お解りになる方がいらっしゃいましたら回答をよろしくお願い致します。

回答No.5

stingy · ベストアンサー

3箇所確認してください。

・If文
> If name = "" Then
> id = ThisWorkbook.Worksheets("集計").Cells(8, 10).Value '▲"集計"に変更

ここの[If name = "" Then]は不要です。

[If name = "" Then]は「もし名前が空白なら」なので
名前が空白のときしかidを取得しないことになってしまい不都合です。

[If<条件式>Then]の後に必要な処理を入れたら最後は[End If]が必要です。
[End If]がないとどこまでがその場合にするべき処理なのか判りません。
字下げしているのは[If～End If]の塊りが解りやすいようにです。
[For ]の行と[Next ]の行、[Sub ]と[End Sub]の行頭を揃えているのもそのためです。

・Cells
> id = ThisWorkbook.Worksheets("集計").Cells(8, 10).Value
Cellsの()内は(行,列)なので(8,10)だと
マクロが定義されているブックの"集計"シートのJ8を示します。

参照する行を名前と同じく1行づつずらしていくには[i]を指定します。
([i]は[For ]と[Next i]の作用で2,3,4,・・・と変化します。)
もしidがJ列ならCells(i,10)、C列ならCells(i,3)にします。
(もしidが他のブックに書かれているなら別の処理が必要です。)

・文字列結合
[Dim id As String]の[String]は「文字列型」で、
[id]と[name]は同じ型なので[+]で結合できます。
fname = name + id + ".xls" でOKです。

(「整数型」＋「整数型」は算数と同じ加算になります。
「文字列型」＋「整数型」など型が違う場合はエラーになります。)

・不要な[If name = "" Then]を削除
・idの記載されているセルを確認
・[fname = name + id + ".xls"]とする
これで試してみて下さい。

お礼

できました！！

ありがとうございます。
iに変更していなかったところを修正し、IDをnameのまえにもって行ったらできました。
何日も何日も本当にありがとうございました。感激です。
今後も教わりたいくらいなので授業料を支払いくらいです。
どの様にお礼すればいいいでしょうか？
本当にありがとうございました。

補足

本当にすみません。
言われた箇所を直して下記のようにしてみましたが、集計表の名前のC列からIDを読み込みコピーされたファイルにIDも反映させたいんですがどうしてもできません。
やはりまだどこかおかしいでしょうか？
本当に申し訳なく思います。

Sub Macro1() 'マクロ名※解りやすい名前に修正してください

Dim name As String '名前
Dim fname As String 'ファイル名
Dim directory As String '作成先ディレクトリ
Dim fullpath As String 'フルパス
Dim orgfile As String '雛形のファイル名
Dim editbook As Workbook '個人データブック
Dim id As String '社員番号

directory = "C:\test\" 'フォルダー名※修正してください
orgfile = "C:\test\マスター.xls" '※修正してください▲

For i = 2 To 100 '開始行と終了行です※修正▲2行目からに変更
'Sheet1のA列を取得※シート名は必要なら修正
name = ThisWorkbook.Worksheets("集計").Cells(i, 1).Value '▲"集計"に変更
If name = "" Then
id = ThisWorkbook.Worksheets("集計").Cells(1, 3).Value 'C列から読み込む
Exit For '空白なら終了
End If

'コピーしたファイルを作成する
fname = name + id + ".xls" 'ファイル名合成
fullpath = directory + fname 'フルパス合成
Call MakeCopyFile(fullpath, orgfile) 'ファイル作成

'作成したブックを開く
'既に開いているブックと同名の場合の処理は省略
Workbooks.Open Filename:=fullpath 'ファイルを開いて
Set editbook = Workbooks(fname) '個人データブックとして認識

'シート"Hinagata1"のB5にnameをセット※シート名は修正してください
editbook.Worksheets("Sheet1").Cells(8, 14).Value = name '▲"Sheet1"に変更
editbook.Worksheets("Sheet1").Cells(8, 10).Value = id 'j8にID番号を自動で反映させる
'※(その他必要な処理があれば追加してください)

'ブックを上書きして閉じる※開きっぱなしが良ければ消してください
editbook.Close (True)
Next i
End Sub

回答No.6

stingy

>どの様にお礼すればいいいでしょうか？
「できました！」　だけで充分です。
というかそれが一番。
回答した者には「諦めました。」とか
[ノーコメントで放置]が一番悲しいので。
後は〆ておいていただければ。

今後は[Visual Basic Editor]の使い方
特にF8でのステップ実行と変数の値の変化を確認することを
覚えてください。
わからないことがあったらOffice系カテへ。
あそこでは私など足元にも及ばない方々が回答されてます。

お疲れ様でした。

お礼

本当にありがとうございました。
これをきっかけにどんどん勉強していこうとおもいます。

F8でのステップ実行と変数の値の変化を確認することですね。
色々ありがとうございました。

回答No.4

stingy

>Sub　または　Functionが定義されていませんとなってしまいます。
ANo.2(08/07/10 01:41)の
Sub MakeCopyFile(newfile As String, orgfile As String)　以下を
転記してないのでは？

Macro1()内の
　　'Sheet1のA列を取得※シート名は必要なら修正してください
　　name = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
"ThisWorkbook"は"このマクロが定義されているブック"の意味なので
syukeihyo.xlsを開き
[ツール][マクロ][Visual Basic Editor]と進み
プロジェクトエクスプローラで右クリック[挿入][標準モジュール]
syukeihyo.xls-Module1(コード)に３つとも貼り付けてください。

（ANo.1(08/07/09 03:00)のはあったら邪魔だから消してね。）

お礼

またまたすみません

名前同様IDナンバーも同じようにファイル名の次につなげたい場合
（例織田信長1023.xls）

とする場合下記のようなコードでは駄目でしょうか？
ファイル名合成のプラスのやり方がわかりません。

Sub Macro1() 'マクロ名※解りやすい名前に修正してください

Dim name As String '名前
Dim fname As String 'ファイル名
Dim directory As String '作成先ディレクトリ
Dim fullpath As String 'フルパス
Dim orgfile As String '雛形のファイル名
Dim editbook As Workbook '個人データブック
Dim id As String '社員番号

directory = "C:\test\" 'フォルダー名※修正してください
orgfile = "C:\test\マスター.xls" '※修正してください▲

For i = 2 To 100 '開始行と終了行です※修正▲2行目からに変更
'Sheet1のA列を取得※シート名は必要なら修正
name = ThisWorkbook.Worksheets("集計").Cells(i, 1).Value '▲"集計"に変更
If name = "" Then
id = ThisWorkbook.Worksheets("集計").Cells(8, 10).Value '▲"集計"に変更
If name = "" Then
Exit For '空白なら終了
End If

'コピーしたファイルを作成する
fname = name + ".xls" 'ファイル名合成
fullpath = directory + fname 'フルパス合成
Call MakeCopyFile(fullpath, orgfile) 'ファイル作成

'作成したブックを開く
'既に開いているブックと同名の場合の処理は省略
Workbooks.Open Filename:=fullpath 'ファイルを開いて
Set editbook = Workbooks(fname) '個人データブックとして認識

'シート"Hinagata1"のB5にnameをセット※シート名は修正してください
editbook.Worksheets("Sheet1").Cells(8, 14).Value = name '▲"Sheet1"に変更
editbook.Worksheets("Sheet1").Cells(8, 10).Value = id
'※(その他必要な処理があれば追加してください)

'ブックを上書きして閉じる※開きっぱなしが良ければ消してください
editbook.Close (True)
Next i
End Sub

補足

なんてお礼をしていいかわかりません。

ダウンロードしたファイルは無事動作いたしました。

これをヒントにブックの名前の後ろにもIDナンバーが付き更に
それぞれコピーされたファイルにIDナンバーを埋め込んでいくマクロを作成してみます。

あと上記の件もこれからやってみます。
本当にありがとうございます。

回答No.3

stingy

Sub Macro1()　 'マクロ名※解りやすい名前に修正してください

　Dim name As String　 '名前
　Dim fname As String　 'ファイル名
　Dim directory As String　 '作成先ディレクトリ
　Dim fullpath As String　 'フルパス
　Dim orgfile As String　 '雛形のファイル名
　Dim editbook As Workbook　 '個人データブック

　directory = "H:\test\"　 'フォルダー名※修正してください
　orgfile = "H:\test\Hinagata.xls"　 '※修正してください

　For i = 1 To 100　 '開始行と終了行です※修正してください
　　'Sheet1のA列を取得※シート名は必要なら修正してください
　　name = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
　　If name = "" Then
　　　Exit For　 '空白なら終了
　　End If

　　'コピーしたファイルを作成する
　　fname = name + ".xls"　 'ファイル名合成
　　fullpath = directory + fname　 'フルパス合成
　　Call MakeCopyFile(fullpath, orgfile)　 'ファイル作成

　　'作成したブックを開く
　　'既に開いているブックと同名の場合の処理は省略
　　Workbooks.Open Filename:=fullpath　 'ファイルを開いて
　　Set editbook = Workbooks(fname)　 '個人データブックとして認識

　　'シート"Hinagata1"のB5にnameをセット※シート名は修正してください
　　editbook.Worksheets("Hinagata1").Cells(5, 2).Value = name
　　'※(その他必要な処理があれば追加してください)

　　'ブックを上書きして閉じる※開きっぱなしが良ければ消してください
　　editbook.Close (True)
　Next i
End Sub

お礼

作成していただき本当に嬉しく思いますがどうも
何回テストしても
'コピーしたファイルを作成する
fname = name + ".xls" 'ファイル名合成
fullpath = directory + fname 'フルパス合成
Call MakeCopyFile(fullpath, orgfile) 'ファイル作成

Call MakeCopyFileの所で止まってしまいます。
Sub　または　Functionが定義されていませんとなってしまいます。
何がいけないのでしょうか？
一応下記に作成してある
http://syuminity.com/aaa/syukeihyo.xls
　　　　　　　　　　　　（↑集計表.xlsです）
http://syuminity.com/aaa/odanobunaga1023.xls
　　　　　　　　　　　　（↑織田信長1023.xlsです）
半角英数字でないとダウンロードできなかったのでブック名が
半角英数字になっていますが、本当は漢字です。

この集計表のA列の名前のファイルを上から順番に作成していきたいと考えています。本当に申し訳ありません。

補足

遅くなりまして大変もうしわけございません。

今日がどうしてもパソコンが出来ないので明日やってみます。
本当すみません。

回答No.2

stingy

あくまでヒントのレベルでのアドバイスしかできませんのでご了承ください。

エクセルのバージョンによっては仕様が異なる機能もありますし
ネット上の文章だけでは要望・使用環境等も正確には伝わらないものです。
文字数制限もあるので書かなくてもと思う部分は省略する場合もありますし
そのまま使用できることはあまりないと思ってください。

前回は最初の部分を[Sub～End Sub]で括ってませんし
大まかな流れを書いただけなのでエラーになります。

文字数制限上、分けてサンプルを載せます。
標準モジュールに転記して、※の部分を修正してください。

個人用ファイルは既にあった場合、コピーしなおしてません。
どちらの場合もセルB5に名前はいれてます。
既に開いているブックと同名の場合の処理は省略しています。

---------------

'ファイル作成
Sub MakeCopyFile(newfile As String, orgfile As String)
　If SearchFile(newfile) Then
　　Exit Sub '既にあったら終了
　End If

　Set fs = CreateObject("Scripting.FileSystemObject")
　'既にあるファイル[newfile]を上書きする場合は書き方が違うので注意
　fs.CopyFile orgfile, newfile
End Sub

' ファイル検索(関数にするほどでもないけど)
Function SearchFile(fname As String) As Boolean
　SearchFile = False
　Set fs = Application.FileSearch
　With fs
　　.Filename = fname
　　If .Execute() > 0 Then
　　　SearchFile = True
　　End If
　End With
End Function

お礼

本当にすみません本当に出来ません。
http://syuminity.com/aaa/syukeihyo.xls　　　
　　　　　　　　　（↑集計表.xlsです）
http://syuminity.com/aaa/odanobunaga1023.xls　
　　　　　　　　　　　　　（↑織田信長1023.xlsです）
半角英数字でないとダウンロードできなかったのでブック名が
半角英数字になっていますが、本当は漢字です。

この集計表のA列の名前のファイルを上から順番に作成していきたいと考えています。

上記のファイルからサンプルは作成できませんでしょうか？
何とかして作成したいと思っていて失礼をお許し下さい。

補足

遅くなりまして大変もうしわけございません。
今日がどうしてもパソコンが出来ないので明日やってみます。
本当すみません。

回答No.1

stingy

後半意味が解りませんが、

繰り返し処理にはForを使います。
A列の文字列を取得し、何かするにはこんな感じ。

---------------------------------------------------
Dim name As String '名前
Dim fname As String 'ファイル名
Dim editbook As Workbook '個人データブック

For i=1 To 100 '開始行と終了行は適当です
　name = ThisWorkbook.Worksheets("(シート名)").Cells(i, 1).Value
　If name = "" Then
　　Exit For '空白なら終了
　End If
　fname = name + ".xls" 'ファイル名合成
　Call MakeFile(fname) 'ファイル作成
　Workbooks.Open Filename:= fname 'ファイルを開いて
　Set editbook = Workbooks(fname) '個人データブックとして認識
　'(何をしたいのか理解できませんでした)
　'editbook.Worksheets("(シート名)").Cells(r, c).Value = name とか？
Next i

---------------------------------------------------
'ファイル作成
Sub MakeFile(fname As String)
　If SearchFile(fname) Then
　　Exit Sub　　　　'既にあったら終了
　End If

　'「雛形.xls」みたいなものをコピーしてfnameに名前変更？
　'新規ブックを作成してfnameで保存？
　'とりあえず省略します
End Sub

---------------------------------------------------
' ファイル検索(関数にするほどでもないけど)
Function SearchFile(fname As String) As Boolean
　SearchFile = False
　Set fs = Application.FileSearch
　With fs
　　.LookIn = (ディレクトリ名)
　　.Filename = fname
　　If .Execute() > 0 Then
　　　　SearchFile = True
　　End If
　End With
End Function

---------------------------------------------------

ちなみに、エクセルですよね？
質問はもう少し絞り込んで、
　[繰り返し]とか[文字列操作][ファイルのコピー][シートのコピー]
　[あるセルの内容を別のブックの特定のセルにコピーしたい]とか
カテゴリーはできれば[ソフトウェア-Office系ソフト]で
質問しなおしたほうがいいかもです。

補足いただければ判る範囲で回答しますが
[Office系ソフト]のほうが多くの方の良答が得られるかと。

補足

早速のご回答誠にありがとうございます。
質問を絞り込んでいなくて本当にすみません。

＞ちなみに、エクセルですよね？
　　はい、エクセルです。

「雛形.xls」みたいなものをコピーしてfnameに名前変更したいです。
そしてその雛形の中にある
（B5に名前を自動で埋め込めると尚良いんですが）

上記のプログラムをそのまま実行するとインデックスが有効の範囲にありませんとなってしまいます。それを解決するにはどうすればいいでしょうか？
この三つのプログラムは別々に分けておかないといけないんでしょうか？
本当に申し訳ないとおもいますがよろしくお願いします。