お世話になっています
ExcelのVBAで、あるフォルダの中にあるファイルに自動的に名前を付けたいのですが、どうしてもうまくいきません
「HOZON」(C:\Documents and Settings\TANAKA\デスクトップ\HOZON)というフォルダの中に「A」「B」「C」という3つのファイルがあります
その中にはそれぞれ
「Aファイル」→「A-S1」、「A-S2」、「A-S3」(3枚のシート)
「Bファイル」→「B-S1」、「B-S2」(2枚のシート)
「Cファイル」→「C-S1」(1枚のシート)
というシートがあります
そして、それぞれのシートの「A1」のセルには
「A-S1」→100
「A-S2」→101
「A-S3」→102
「B-S1」→200
「B-S2」→201
「C-S1」→300
という数字が入っています
やりたいことは
VBAでそれぞれのファイルの名前を
「【100-102】A」
「【200-201】B」
「【300】C」
と変えたいのです
つまり、現在の名前に、シートに書かれている一番小さい数字から大きい数字までを"-"でつないだ文字を付加して名前を付けなおしたいのです
ThisWorkbook.SaveAs Filename:=
で名前を付けると思うのですが、書くファイルの名前の取得の仕方とシートに書いてあるセルからの数字と合わせてリネームする方法がどうしてもわかりません
すいませんが、ファイルの数が膨大なので、教えていただけると大変助かります
宜しくお願いします
No.2ベストアンサー
- 回答日時:
ANo.1のkuma3fです。
補足ですが、私の勘違いでファイル名に"【"が使えないとしていましたが使えますのですみません。
先のコードの"#"を"【"に変えてください。
変更後の名前 = "#" & テーブル最大値 & "#" & 文字列
↓
変更後の名前 = "【" & テーブル最大値 & "】" & 文字列
変更後の名前 = "#" & テーブル最小値 & "-" & テーブル最大値 & "#" & 文字列
↓
変更後の名前 = "【" & テーブル最小値 & "-" & テーブル最大値 & "】" & 文字列
また、先のコードはシート名がAファイルが「A-S1」、Bファイルが「B-S1」のようにされていましたのでシート名にファイル名が含まれているものを対象にしています。
もし、ファイル名とシート名に関連性がないのでしたら先のコードの
「If シート名 Like 文字列 & "*" Then」と「End If」を削除してください。(削除することで全シートが対象になります)
For Each シート In Workbooks(対象ファイル).Sheets 'シート検索
シート.Activate
シート名 = ActiveWorkbook.ActiveSheet.Name
文字列 = Left(対象ファイル, Len(対象ファイル) - 4)
'If シート名 Like 文字列 & "*" Then ←削除してください
シート数 = シート数 + 1
テーブル(シート数) = Workbooks(対象ファイル).Sheets(シート名).Range("A1")
If テーブル最小値 > テーブル(シート数) Then
テーブル最小値 = テーブル(シート数)
End If
If テーブル最大値 < テーブル(シート数) Then
テーブル最大値 = テーブル(シート数)
End If
'End If ←削除してください
Next シート
あーわかりました
すごく助かりました
本当に本当にありがとうございました
長いコードをありがとうございます
大変勉強になりました
No.1
- 回答日時:
思われていることと違っていましたらすみませんが、次のコードを新規Bookのマクロに貼り付けて、そのBookを変換したいファイルのあるフォルダーの中に自由な名前をつけて保存し、保存したBookを開いてそのマクロを実行してみてください。
既存のファイルを壊してはいけないので、必ず、コピーしたフォルダー内でテスト的に行ってみてください。
新規BooKを開く
↓
メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。(例:変換)
↓
名前を入力しましたら、「作成」をクリック
↓
Microsoft Visual Basicの画面が開きますのでSub 変換()の下に次のコードをコピーして貼り付けてください。
'<定義>
Dim パス名, 当ファイル, 当ファイル名, 対象ファイル, 変更後の名前, シート名, 文字列 As String
Dim テーブル最小値, テーブル最大値, テーブル(256) As String
Dim ファイル数, シート数 As Long
Dim シート As Worksheet
'<処理>
Application.ScreenUpdating = False
パス名 = ActiveWorkbook.Path & "\"
当ファイル = ActiveWorkbook.Name
当ファイル名 = パス名 & 当ファイル
Sheets("sheet1").Cells.ClearContents
With Application.FileSearch 'ファイルの検索
.NewSearch
.LookIn = パス名
.Filename = "*.xls"
.SearchSubFolders = True
If .Execute() > 0 Then
For ファイル数 = 1 To .FoundFiles.Count
If 当ファイル名 <> .FoundFiles(ファイル数) Then
Sheets("sheet1").Cells(ファイル数, 1) = .FoundFiles(ファイル数)
Workbooks.Open Filename:=.FoundFiles(ファイル数) 'ファイルのOPEN
対象ファイル = ActiveWorkbook.Name
シート数 = 0
テーブル最小値 = 999
テーブル最大値 = 0
For Each シート In Workbooks(対象ファイル).Sheets 'シート検索
シート.Activate
シート名 = ActiveWorkbook.ActiveSheet.Name
文字列 = Left(対象ファイル, Len(対象ファイル) - 4)
If シート名 Like 文字列 & "*" Then
シート数 = シート数 + 1
テーブル(シート数) = Workbooks(対象ファイル).Sheets(シート名).Range("A1")
If テーブル最小値 > テーブル(シート数) Then
テーブル最小値 = テーブル(シート数)
End If
If テーブル最大値 < テーブル(シート数) Then
テーブル最大値 = テーブル(シート数)
End If
End If
Next シート
If テーブル最小値 = テーブル最大値 Then
変更後の名前 = "#" & テーブル最大値 & "#" & 文字列
Else
変更後の名前 = "#" & テーブル最小値 & "-" & テーブル最大値 & "#" & 文字列
End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=パス名 & 変更後の名前 & ".xls" '保存
Application.DisplayAlerts = True
ActiveWorkbook.Close False 'ファイルのCLOSE
End If
Next
End If
End With
Application.ScreenUpdating = True
MsgBox "変換が終了しました。"
'****コピー貼り付けはここまで ****
Microsoft Visual Basicの画面を×で閉じます
↓
この新規Bookを変換したいファイルのフォルダー内に名前をつけて保存します
↓
保存したらこのBookを開く
↓
Excel画面のメニューバーの「ツール」→「マクロ」→「マクロ」をクリック
↓
先ほど名前を付けたマクロ(変換)を選択して「実行」をクリック
作成されると思います。
ファイル名に"【"が使用できませんので"#"にしています。(「【100-102】A」は「#100-102#A」になります。)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【VBA】PDF出力に任意のファイル名前を付ける方法 3 2023/07/21 10:55
- Excel(エクセル) Excel VBAどこが間違ってますか? 4 2023/07/17 10:04
- Visual Basic(VBA) 集めたシートのシート名を変更したい。 下記のコードでサブフォルダにあるファイルのSheet3を集めて 6 2022/08/23 10:38
- Excel(エクセル) Excel、同じフォルダ内のExcelファイルの特定シートのみを1つのファイルに集約したい 8 2022/09/07 15:12
- システム vba シートの追加について 2 2023/05/17 15:58
- Visual Basic(VBA) Excel ファイルを指定し、指定されたファイル内にシートを統合するVBA 8 2023/07/10 10:09
- Visual Basic(VBA) 複数ブックの統合について Excel VBA 1 2022/05/13 09:48
- Visual Basic(VBA) excelにて、特定の列に数字入力してあれば、入力してある行コピーして 別ファイルに張り付ける 2 2022/08/11 05:33
- Excel(エクセル) ExcelVBA メモ帳を起動し名前を付けて指定フォルダに保存 2 2022/04/18 13:15
- Excel(エクセル) フォルダ内のファイル全てに対して、シート名・ファイル名を変更する方法(マクロ VBA) 2 2022/04/02 10:56
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルファイルを開く時、常...
-
エクセルの一部のセルの背景色...
-
エクセルで複数のシートの1枚目...
-
エクセルで行番号、列アルファ...
-
1ヶ月分の日付を一度に出す方法...
-
エクセルでのヘッダーをページ...
-
エクセルのシート名を印刷した...
-
エクセル印刷時 一枚の書類に...
-
エクセルの行タイトルを特定の...
-
EXCELで複数のシートを同時に印...
-
エクセルで複数のシートを同じ...
-
エクセルでシートの色がグレー...
-
条件によって印刷するシートを...
-
エクセルのマクロで複数シート...
-
Excel 特定のシートを印刷不可...
-
マクロで印刷→セルの値から部数...
-
特定のセルに数値が入っている...
-
特定のシートのみ印刷できない...
-
EXCELで宛名だけ連続変更...
-
Excel 2シートを1枚に印刷した...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルファイルを開く時、常...
-
エクセル印刷時 一枚の書類に...
-
エクセルの一部のセルの背景色...
-
エクセルの行タイトルを特定の...
-
1ヶ月分の日付を一度に出す方法...
-
エクセルで複数のシートの1枚目...
-
Excel 特定のシートを印刷不可...
-
エクセルでのヘッダーをページ...
-
マクロで印刷→セルの値から部数...
-
エクセルのマクロで複数シート...
-
エクセルで行番号、列アルファ...
-
エクセルで複数のシートを同じ...
-
エクセルでシートの色がグレー...
-
EXCELで複数のシートを同時に印...
-
エクセルのシート名を印刷した...
-
条件によって印刷するシートを...
-
エクセルの複数シートをNアップ...
-
エクセルで、ヘッダーに他のシ...
-
カラーで一括印刷したいです
-
EXCELで宛名だけ連続変更...
おすすめ情報