人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルVBAについて質問です。次のページにあるようなマクロを作ってください。
http://hatena88.web.fc2.com/hatena/newpage2.shtml
なお、現在勉強中ですので、下記の質問の回答者4の方のような解説を付け加えていただいた方には追加ポイントのおまけを付けます。もしそれが必要なければマクロだけでも結構です。よろしくお願いします。
http://q.hatena.ne.jp/1158311664

●質問者: taroemon
●カテゴリ:コンピュータ
✍キーワード:VBA エクセル ポイント マクロ 勉強
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ●
●10ポイント

こんな感じでいかがでしょうか。

内容はほとんど同じなのでコメントは一部のみにいたしました。

Option Explicit
Const strPath = "D:\XX"
Sub replaceStarsToSheetName()
 
 Dim objFs As Object, objFld As Object, objFl As Object, Stream As Object, buf As String, i As Long
 
 Set objFs = CreateObject("Scripting.FileSystemObject")
 Set objFld = objFs.GetFolder(strPath)
 
 Set Stream = CreateObject("ADODB.Stream")
 
 ' 2シート目を対象にするために、iは2から始める
 i = 2
 For Each objFl In objFld.Files
 '
 ' MsgBox (objFl.Name) ' ファイル名の確認
 ' シートが存在する間、処理を実行
 If i <= Worksheets.Count Then
 Stream.Open
 Stream.Type = 2
 Stream.Charset = "utf-8"
 Stream.LoadFromFile objFl.Path
 buf = Stream.readText()
 buf = Replace(buf, "★★", Worksheets(i).Name)
 ' MsgBox (buf) ' 置換後の内容の確認
 Stream.Close
 Else
 MsgBox ("名称を取得するシートがありません。" &amp; vbCrLf &amp; "処理を中断しました。")
 Exit Sub
 End If
 i = i + 1
 ' 次のファイルに移動
 Next
 MsgBox ("すべてのファイルを処理しました。")

End Sub

参考になれば幸いです。

[参考URL]

◎質問者からの返答

ご回答ありがとうございます。


2 ●
●150ポイント

つまらないミスをしていたので修正しました。

ちょっと寝ぼけているようなので、こちらにもミスがありましたら申し訳ありません。

Option Explicit
Const strPath = "D:\XX"
Sub replaceStarsToSheetName()
 
 Dim objFs As Object, objFld As Object, objFl As Object, Stream As Object, buf As String, i As Long
 
 Set objFs = CreateObject("Scripting.FileSystemObject")
 Set objFld = objFs.GetFolder(strPath)
 
 Set Stream = CreateObject("ADODB.Stream")
 
 ' 2シート目以降のシート名を対象にするために、iは2から始める
 i = 2
 For Each objFl In objFld.Files
 '
 ' MsgBox (objFl.Name) ' ファイル名の確認
 ' シートが存在する間、処理を実行
 If i <= Worksheets.Count Then
 
 Stream.Open
 Stream.Type = 2
 Stream.Charset = "utf-8"
 Stream.LoadFromFile objFl.Path
 buf = Stream.readText()
 buf = Replace(buf, "★★", Worksheets(i).Name)
 ' MsgBox (buf) ' 置換内容の確認
 Stream.Close
 
 Stream.Open
 Stream.Type = 2
 Stream.Charset = "utf-8"
 Stream.writeText (buf)
 Stream.SaveToFile objFl.Path, 2
 Stream.Close
 
 Else
 MsgBox ("名称を取得するシートがありません。" &amp; vbCrLf &amp; "処理を中断しました。")
 Exit Sub
 End If
 i = i + 1
 ' 次のファイルに移動
 Next
 MsgBox ("すべてのファイルを処理しました。")
 
End Sub

ファイル名はいわゆる名前の順で取得されます。

[参考URL]

◎質問者からの返答

ご回答ありがとうございました。

完璧に望んでいたものです。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ