[[20220522095110]]　『フォルダ内の複数ブック　特定シート　特定の文字』（カプセル）　ページの最後に飛ぶ

『フォルダ内の複数ブック　特定シート　特定の文字列　フォントサイズ変更』（カプセル）

フォルダ内の複数ブック、特定シート内の特定の文字列をフォントサイズ一括変更マクロ

フォルダ内に200件近くブックがあります。
複数ブックの特定シート(仮に調書-1)で
特定の文字列だけをフォントサイズ8から7へ変更したいのです。
(文字列"果物")
特定の文字列が入っているセルの場所はブックによりまちまちです。
マクロで一括処理できないのもでしょうか。

皆様からご教授お願い致したいです。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

「できないか」と言えば、できると思いますが、丸投げはあまり良くないかと思うのでご自身でまずは作って訂正してもらうのがいいかと思います。

基本的にはファイルのフルパスを順番に取得して、一つずつブックを開き、処理していくだけだと思います。

ファイルの一覧はDir関数かFileSystemObjectを使うのが鉄板ですが、一度しかやらない操作ならエクスプローラーでファイルを全選択してパスをコピーし、どこかのシートに貼り付ける方法もあります。
（ds） 2022/05/22(日) 12:51

（ds）様
コメントありがとうございます。
月曜日までに処理しなければならなかったので
ついつい甘えてしまい申し訳ございません。
マクロでやると早いと聞いたもので。。。
時間はかかりますが手作業でやります。

すみません。ありがとうございました。

（カプセル） 2022/05/22(日) 13:06

 マクロを使用するきっかけにでもなれば。
 とりあえずのサンプルです。
 標準モジュールに置いて実行してみてください。

 Option Explicit
 Public Const targetWSName = "調書-1"
 Public Const targetText = "果物"

 Sub 一括変換()
    Dim fso As New Scripting.FileSystemObject '// 「ツール」 ⇒ 「参照設定」で Microsoft Scripting Library にチェック
    Dim aFile
    Dim ws As Worksheet
    For Each aFile In fso.GetFolder(ThisWorkbook.Path).Files '// マクロEXCELファイルのあるフォルダを処理
        If fso.GetExtensionName(aFile.Path) = "xlsx" Then
            With Workbooks.Open(aFile.Path)
                For Each ws In .Worksheets
                    If ws.Name = targetWSName Then
                        ChangeFontSize ws
                        Exit For
                    End If
                Next
                .Save
                .Close
            End With
        End If
    Next
 End Sub

 Sub ChangeFontSize(ws As Worksheet)
    Dim findCell As Range
    Dim firstFindCell As Range

    With ws.Cells
        Set firstFindCell = .find(targetText, LookAt:=xlPart)
        Set findCell = firstFindCell

        Dim st
        Do
            If findCell Is Nothing Then Exit Sub
            st = InStr(findCell.Text, targetText)
            Do While st <> 0
                findCell.Cells.Characters(st, Len(targetText)).Font.Size = 7
                st = InStr(st + 1, findCell.Text, targetText)
            Loop
            Set findCell = .FindNext(findCell)
        Loop Until findCell.Address = firstFindCell.Address
    End With
 End Sub
（QS） 2022/05/22(日) 13:22

（QS）様
ありがとうございます。。。。
あきらめかけてました。

こんな凄いプログラムを記述しなければならないのですね。。
（ds）さんが「丸投げはあまり良くない」とおっしゃった意味が分かりました。

早速試してみます！！！！！！
本屋でマクロ初心者の本を漁ってみます。

（ds）さん
（QS）さん本当にお手数をお掛けしました。
感謝でございます。
（カプセル） 2022/05/22(日) 16:07

コメント返信：

[ 一覧(最新更新順) ]

[[20220522095110]] 『フォルダ内の複数ブック 特定シート 特定の文字』（カプセル） ページの最後に飛ぶ

[[20220522095110]]　『フォルダ内の複数ブック　特定シート　特定の文字』（カプセル）　ページの最後に飛ぶ