Q'=========================== ' フォルダ作成メイン処理 '=========================== Sub CreateFoldersWithSheetDate_AllColumns_BoldOnly() Dim basePath As String Dim sheetName As String Dim dt As Date Dim datePrefix As String Dim yearPart As String, monthPart As String, dayPart As String Dim tailText As String Dim targetCols As Variant Dim col As Variant Dim lastRow As Long Dim i As Long Dim txt As String, namePart As String Dim p1 As Long, p2 As Long Dim folderName As String basePath = "C:\Users\user\Desktop\LINE写真保存用\" If Dir(basePath, vbDirectory) = "" Then MsgBox "保存先フォルダが見つかりません: " & basePath, vbExclamation Exit Sub End If sheetName = ActiveSheet.Name '--- シート名が8桁(YYYYMMDD)の場合 --- If Len(sheetName) = 8 And IsNumeric(sheetName) Then yearPart = Left(sheetName, 4) monthPart = Mid(sheetName, 5, 2) dayPart = Right(sheetName, 2) '--- シート名が4桁(MMDD)の場合 --- ElseIf Len(sheetName) = 4 And IsNumeric(sheetName) Then yearPart = Year(Date) monthPart = Left(sheetName, 2) dayPart = Right(sheetName, 2) Else MsgBox "シート名は「YYYYMMDD」または「MMDD」の形式にしてください。", vbExclamation Exit Sub End If On Error Resume Next dt = DateSerial(yearPart, monthPart, dayPart) On Error GoTo 0 If dt = 0 Then MsgBox "シート名の日付が正しくありません。", vbExclamation Exit Sub End If datePrefix = Month(dt) & "月" & Day(dt) & "日" ' 対象列:A列(1), C列(3), E列(5) targetCols = Array(1, 3, 5) For Each col In targetCols ' 列ごとに 1 行目の文字を tailText として取得 tailText = Cells(1, col).Value lastRow = Cells(Rows.Count, col).End(xlUp).Row For i = 1 To lastRow If Cells(i, col).DisplayFormat.Font.Bold = True Then txt = Cells(i, col).Value p1 = InStr(txt, "名前:") p2 = InStr(txt, "顧客") If p1 > 0 And p2 > p1 Then namePart = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) namePart = Trim(namePart) ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePart = Replace(namePart, " ", "") namePart = Replace(namePart, " ", "") If namePart <> "" Then ' ★ (北恵)の前にスペースを入れない ' 日付と名前の間だけ全角スペースを1つ残す folderName = datePrefix & " " & namePart & "様邸(北恵)" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If End If End If Next i Next col MsgBox "LINE写真保存用フォルダへの作成が完了しました!" End Sub '=========================== ' 禁止文字+改行+末尾の . / 半角スペース を除去 '=========================== Private Function CleanFileName(ByVal s As String) As String Dim badChars As Variant Dim c As Variant ' 改行をスペースに s = Replace(s, Chr(10), " ") s = Replace(s, Chr(13), " ") ' 禁止文字をスペースに置き換え badChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|") For Each c In badChars s = Replace(s, c, " ") Next c ' 先頭と末尾の半角スペースを削除 s = Trim(s) ' 末尾が . または 半角スペース の場合は削る Do While Len(s) > 0 And (Right$(s, 1) = "." Or Right$(s, 1) = " ") s = Left$(s, Len(s) - 1) Loop CleanFileName = s End Function このコードの "様邸(北恵)"の部分を編集をしてほしい (北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい 例:顧客:ヤマダ→様邸(ヤマダ)
AユーザーはVBAコードの特定の部分を修正したいと考えている。修正内容は、フォルダ名生成部分で、固定で「(北恵)」となっている部分を、特定のセルから取得した「顧客:」の後の文字列に置き換えたいとのこと。 コードの理解: CreateFoldersWithSheetDate_AllColumns_BoldOnly サブルーチンがメインの処理。 basePath に保存先ディレクトリが指定されている。 シート名から日付 (datePrefix) を取得している。 targetCols (A, C, E列) をループしている。 各列の1行目から tailText を取得している。 各列のセルをループし、太字 のセルを探している。 太字のセルの値 (txt) から「名前:」と「顧客」という文字列の位置を探し、namePart を抽出している。 namePart から不要なスペースを削除している。 folderName を datePrefix & " " & namePart & "様邸(北恵)" & tailText の形式で生成している。 CleanFileName 関数でファイル名として不正な文字を除去している。 修正箇所の特定: folderName を生成している行: folderName = datePrefix & " " & namePart & "様邸(北恵)" & tailText ここの "様邸(北恵)" の部分を、namePart の抽出時に取得した「顧客:」の後ろの文字列(例:「ヤマダ」)に置き換えたい。 問題点の分析: 現在のコードでは、namePart は「名前:」と「顧客」の間にある文字列を抽出している。 ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」を見ると、「顧客:」という文字列自体も namePart の抽出条件に関わっている可能性がある。 コードを見ると、p1 = InStr(txt, "名前:") で「名前:」の位置を取得し、p2 = InStr(txt, "顧客") で「顧客」の位置を取得している。 namePart = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) で、「名前:」の直後から「顧客」の直前までの文字列を namePart として取得している。 つまり、namePart は「名前:〇〇 顧客」のようなテキストの場合、「〇〇」の部分になる。 ユーザーの要望は、「名前:〇〇 顧客:ヤマダ」のようなテキストがあり、フォルダ名に「様邸(ヤマダ)」としたい、ということだと解釈できる。 しかし、現在のコードでは「顧客」という文字列を区切り文字として使っているため、「顧客:ヤマダ」という部分を直接 namePart として取得することはできていない。 修正方針の検討: 案1: 「顧客:」という文字列も namePart の抽出範囲に含めるように p2 の取得方法を変更する。 p2 = InStr(txt, "顧客:") のように、「顧客:」を検索する。 その場合、namePart は「名前:〇〇 顧客:」までを取得してしまう。 さらに、namePart から「顧客:」を取り除く処理が必要になる。 案2: 「名前:」と「顧客」の間から「名前:」を取り除き、さらに「顧客:」の後ろから「顧客」までの文字列を抽出する。 これは少し複雑になりそう。 案3: ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」は、もしかしたら「名前:」という区切りは使わず、「顧客:」の後ろの文字列を直接取得したいのかもしれない。 しかし、コードの p1 = InStr(txt, "名前:") や p2 = InStr(txt, "顧客") の使われ方から、現状は「名前:」と「顧客」の間にある文字列を namePart としている。 ユーザーの要望を素直に解釈すると、「名前:〇〇 顧客:ヤマダ」のようなテキストがあり、namePart として「ヤマダ」を取得し、フォルダ名に「様邸(ヤマダ)」としたい。 現在の namePart は「〇〇」になっている。 つまり、namePart の抽出ロジック自体を変更する必要がある。 具体的な修正手順 (案1をベースに、よりユーザーの意図に沿うように調整): 現在の namePart は「名前:」と「顧客」の間。 ユーザーは「顧客:」の後ろの文字を使いたい。 つまり、「名前:」と「顧客:」の間の文字列は不要で、「顧客:」の後ろの文字列を namePart として取得したい。 この場合、p1 を「名前:」ではなく、「顧客:」の開始位置として再定義する必要がある。 あるいは、既存の namePart (「名前:」と「顧客」の間) を取得した後、さらに「顧客:」という文字列を探し、その後ろの文字列を抽出する。 再検討: ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」は、元のコードの namePart の抽出ロジックとは少し異なる。 元のコード: namePart = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) 例: txt = "〇〇 名前:山田 顧客 △△" -> namePart = "山田 " ユーザーの要望: 「顧客:」の後ろの文字を使いたい。 例: txt = "〇〇 名前:山田 顧客:ヤマダ △△" -> namePart を「ヤマダ」にしたい。 修正案: 「名前:」と「顧客」の間の文字列 (namePart) を取得するロジックは一旦そのままにしておく。 その namePart を取得した後、さらに txt の中から「顧客:」を探し、その後ろの文字列を抽出する。 もし「顧客:」が見つからなければ、元の namePart を使うか、あるいはエラー処理をする。 コードの場所: If p1 > 0 And p2 > p1 Then ' ここで namePart が取得されている namePart = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) namePart = Trim(namePart) ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePart = Replace(namePart, " ", "") namePart = Replace(namePart, " ", "") ' ここからが修正対象 ' If namePart <> "" Then ' folderName = datePrefix & " " & namePart & "様邸(北恵)" & tailText ' folderName = CleanFileName(folderName) ' If folderName <> "" Then ' If Dir(basePath & folderName, vbDirectory) = "" Then ' MkDir basePath & folderName ' End If ' End If ' End If 具体的な修正ロジック: まず、元の namePart を取得する。 次に、txt の中から「顧客:」を探す。 customerPos = InStr(txt, "顧客:") もし「顧客:」が見つかり、かつそれが「名前:」よりも後ろにある場合 (customerPos > p1)、 「顧客:」の後ろの文字列を新しい namePart とする。 newCustomerName = Mid(txt, customerPos + Len("顧客:")) この newCustomerName から、もし「顧客:」の後ろにさらに不要な文字列(例:「 △△」)があれば、それも除去する必要がある。 元のコードでは p2 (「顧客」の位置) を使って namePart の長さを決めている。 これを「顧客:」の後ろの文字列を抽出するように変更する。 よりシンプルなアプローチ: 「名前:」と「顧客」の間ではなく、「顧客:」の後ろの文字列を直接取得する。 txt の中から「顧客:」を探す。 見つかったら、その位置から後ろの文字列を取得する。 取得した文字列から、不要な部分(例:改行、末尾のスペースなど)を取り除く。 その文字列を namePart として使う。 コードの改変: ' 元のコード ' p1 = InStr(txt, "名前:") ' p2 = InStr(txt, "顧客") ' If p1 > 0 And p2 > p1 Then ' namePart = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) ' namePart = Trim(namePart) ' namePart = Replace(namePart, " ", "") ' namePart = Replace(namePart, " ", "") ' 修正案: Dim customerNamePart As String Dim customerColonPos As Long ' まず、「顧客:」の位置を探す customerColonPos = InStr(txt, "顧客:") If customerColonPos > 0 Then ' 「顧客:」が見つかった場合、その後の文字列を取得 ' 取得する範囲は、"顧客:" の直後から、もし「名前:」が「顧客:」より後にあるならその手前まで、 ' あるいは単に「顧客:」の後ろから最後まで、とする。 ' ここで、元のコードの p1 (名前:の位置) と p2 (顧客の位置) をどう使うか? ' ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」は、txtが "名前:〇〇 顧客:ヤマダ △△" のような形式を想定しているか? ' それとも、txtが "顧客:ヤマダ △△" のような形式でも対応したいか? ' 一旦、元のコードのp1, p2のロジックを活かしつつ、 ' 「顧客:」の後ろの文字列を抽出する方向で考える。 ' ユーザーの例は「名前:」の後に「顧客:」が来ることを想定しているように見える。 ' 取得したいのは「顧客:」の後の文字列。 ' その文字列がどこまでか? ' 元のコードでは「顧客」という文字列を区切りとしていた。 ' もし「顧客:ヤマダ △△」という形式なら、 ' customerColonPos = InStr(txt, "顧客:") ' customerNamePart = Mid(txt, customerColonPos + Len("顧客:")) ' この customerNamePart には "ヤマダ △△" が入る。 ' この "△△" の部分をどう処理するか? ' 元のコードの p2 (「顧客」の位置) は、この「△△」の開始位置を特定するのに役立つかもしれない。 ' 別の考え方: ' 「名前:」と「顧客」の位置を元に、 ' 「顧客:」という文字列を探し、その後の部分を抽出する。 ' もし「顧客:」が見つからなければ、元の `namePart` を使う、というフォールバックも考えられる。 ' コードをシンプルにするために、 ' ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」を素直に解釈する。 ' これは、txtの中に「顧客:」という文字列があり、その直後の文字列をフォルダ名に使いたい、ということ。 ' 元のコードの `p1` と `p2` は、太字のセル内のテキスト `txt` から「名前:」と「顧客」を探している。 ' この `txt` の形式がどうなっているかによって、修正方法が変わる。 '仮定: txtは "〇〇 名前:山田 顧客:ヤマダ △△" のような形式である。 ' ユーザーは「ヤマダ」の部分を使いたい。 ' 元のコードでは、p1=名前:の位置, p2=顧客の位置。 ' namePart = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) -> "山田 " を取得。 ' これではダメ。 ' 修正方針: ' 1. 「顧客:」という文字列を `txt` の中で探す。 ' 2. 見つかったら、その位置から後ろの文字列を取得する。 ' 3. 取得した文字列の末尾に不要な文字(例:「 △△」)がある場合、それを除去する。 ' 4. その結果を `namePart` として使う。 Dim customerColonPos As Long Dim extractedName As String ' まず「顧客:」を探す customerColonPos = InStr(txt, "顧客:") If customerColonPos > 0 Then ' 「顧客:」が見つかった場合、その後の文字列を取得 extractedName = Mid(txt, customerColonPos + Len("顧客:")) ' 取得した文字列から、もし「名前:」が「顧客:」より後にある場合、 ' その「名前:」の手前までを抽出する、というロジックも考えられるが、 ' ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」は、 ' 「顧客:」の後ろがそのまま名前に対応する形式を想定しているように見える。 ' ここで、元のコードの `p2` (「顧客」の位置) が使えそう。 ' `p2` は「顧客」という文字列の開始位置。 ' もし `txt` が "名前:〇〇 顧客 △△" の場合、 `p2` は「顧客」の開始位置。 ' もし `txt` が "名前:〇〇 顧客:ヤマダ △△" の場合、`customerColonPos` は「顧客:」の開始位置。 ' ユーザーの例は「顧客:ヤマダ」なので、`customerColonPos` を使うのが適切。 ' 取得した `extractedName` には「ヤマダ △△」のような文字列が入る可能性がある。 ' この「△△」の部分をどう処理するか? ' 元のコードでは `p2` を使って `namePart` の長さを決めていた。 ' `p2 - (p1 + Len("名前:"))` ' これは「名前:」から「顧客」までの長さ。 ' もし「顧客:」の後ろに余計な文字列がある場合、 ' その余計な文字列の開始位置を特定する必要がある。 ' ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」に素直に従うと、 ' 「顧客:」の後ろの文字列をそのまま使う。 ' ただし、その文字列の末尾に不要なものがないか? ' 元のコードの `CleanFileName` 関数で処理されるので、 ' ここでは一旦、`customerColonPos` の後ろから最後までを取得し、 ' それを `namePart` とする。 ' 修正後の `namePart` 抽出ロジック: Dim customerColonPos As Long Dim namePartCandidate As String ' まず「顧客:」を探す customerColonPos = InStr(txt, "顧客:") If customerColonPos > 0 Then ' 「顧客:」が見つかった場合、その後の文字列を取得 ' 取得する範囲は、「顧客:」の直後から、もし「名前:」が「顧客:」より後にあるならその手前まで。 ' しかし、ユーザーの例は「顧客:ヤマダ」なので、 ' 「顧客:」の後ろから、もし "様邸" や "顧客" などの区切りがあればその手前まで、と考えるのが自然。 ' 元のコードの `p2` は「顧客」の位置。 ' `p1` は「名前:」の位置。 ' `txt` の例: "〇〇 名前:山田 顧客:ヤマダ △△" ' `p1` は「名前:」の開始位置 ' `customerColonPos` は「顧客:」の開始位置 ' `p2` は「顧客」の開始位置 (もしあれば) ' ユーザーの要望「顧客:ヤマダ→様邸(ヤマダ)」を素直に解釈する。 ' フォルダ名に使うのは「ヤマダ」の部分。 ' これは `txt` から「顧客:」を探し、その後の文字列を `namePart` にしたい。 ' `namePart` は、最終的に「様邸()」の中に入るので、 ' 「様邸」や「顧客」といった単語が後ろに来る可能性も考慮する。 ' 修正案: ' 「顧客:」の後ろから、次の「名前:」や「顧客」のような区切り文字、 ' あるいは単に末尾までを取得する。 ' 元のコードの `p2` (「顧客」の位置) は、もし「顧客:」の後に「顧客」という単語が続く場合、 ' その「顧客」の位置を指すことになる。 ' `txt` の例: "〇〇 名前:山田 顧客:ヤマダ △△" ' `p1` = InStr(txt, "名前:") ' `customerColonPos` = InStr(txt, "顧客:") ' `p2` = InStr(txt, "顧客") ' これは「顧客:」とは別の「顧客」を探すことになる。 ' ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」をそのまま実装する。 ' `namePart` を「顧客:」の後ろの文字列にする。 ' その文字列の末尾は、もし「名前:」や「顧客」といった単語があればその手前までとする。 ' しかし、最もシンプルなのは「顧客:」の後ろから最後まで取得し、 ' `CleanFileName` で不要な文字を除去すること。 ' 修正ロジック: Dim customerColonPos As Long Dim namePartFromCustomer As String ' まず「顧客:」を探す customerColonPos = InStr(txt, "顧客:") If customerColonPos > 0 Then ' 「顧客:」が見つかった場合、その後の文字列を取得 namePartFromCustomer = Mid(txt, customerColonPos + Len("顧客:")) ' ここで、もし `namePartFromCustomer` に「名前:」や「顧客」といった単語が ' 含まれている場合、その手前で区切る必要があるかもしれない。 ' 例: "顧客:ヤマダ 名前:田中" -> "ヤマダ" だけを取りたい。 ' 元のコードでは `p2` (「顧客」の位置) を使って区切っていた。 ' `p2` は「顧客」という単語の位置。 ' `customerColonPos` は「顧客:」という文字列の位置。 ' もし `txt` が "名前:山田 顧客:ヤマダ △△" の場合: ' `p1` = InStr(txt, "名前:") ' `customerColonPos` = InStr(txt, "顧客:") ' `p2` = InStr(txt, "顧客") ' これは「顧客:」とは別の「顧客」を探すことになる。 ' ユーザーの例は「顧客:ヤマダ」なので、`customerColonPos` を使うのが自然。 ' `namePartFromCustomer` には「ヤマダ △△」が入る。 ' この「△△」をどう処理するか? ' 元のコードの `p2` (「顧客」の位置) が、この「△△」の開始位置を特定するのに役立つか? ' もし `txt` が "名前:山田 顧客:ヤマダ △△" なら、`p2` は「顧客」の開始位置。 ' `customerColonPos` は「顧客:」の開始位置。 ' `p2` は `customerColonPos` よりも後ろにあるはず。 ' `p2 - customerColonPos` は「:ヤマダ △△」の長さ。 ' ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」を素直に実装する。 ' `namePart` は「顧客:」の後ろの文字列。 ' その文字列の末尾は、もし「名前:」や「顧客」のような区切りがあればその手前まで。 ' `txt` の形式を想定: "〇〇 名前:山田 顧客:ヤマダ △△" ' `p1` = InStr(txt, "名前:") ' `customerColonPos` = InStr(txt, "顧客:") ' `p2` = InStr(txt, "顧客") ' これは「顧客:」とは別の「顧客」を探すことになる。 ' 修正案: ' 1. 「顧客:」の位置 `customerColonPos` を探す。 ' 2. もし見つかったら、`customerColonPos` の後ろから文字列を取得する。 ' 3. その文字列の末尾を、もし `p2` (「顧客」の位置) が `customerColonPos` より後にあるなら、`p2` の手前までとする。 ' そうでなければ、末尾までとする。 Dim customerColonPos As Long Dim namePartFromCustomer As String Dim endPos As Long ' まず「顧客:」を探す customerColonPos = InStr(txt, "顧客:") If customerColonPos > 0 Then ' 「顧客:」が見つかった場合 ' 取得する文字列の開始位置は「顧客:」の直後 Dim startPos As Long startPos = customerColonPos + Len("顧客:") ' 取得する文字列の終了位置を決定する ' もし「顧客」という単語が「顧客:」の後にある場合、その手前まで Dim customerWordPos As Long customerWordPos = InStr(startPos, txt, "顧客") ' startPosから検索 If customerWordPos > 0 Then ' 「顧客:」の後ろに「顧客」という単語がある場合、その手前まで endPos = customerWordPos - 1 Else ' 「顧客」という単語がない場合、文字列の最後まで endPos = Len(txt) End If ' 抽出する文字列の長さを計算 Dim lenToExtract As Long lenToExtract = endPos - startPos + 1 If lenToExtract > 0 Then namePartFromCustomer = Mid(txt, startPos, lenToExtract) namePartFromCustomer = Trim(namePartFromCustomer) ' namePartFromCustomer には「ヤマダ」のような文字列が入る Else ' 抽出できる文字列がない場合 namePartFromCustomer = "" End If Else ' 「顧客:」が見つからなかった場合、元のロジックで `namePart` を取得する ' (これはユーザーの意図と少しずれるかもしれないが、フォールバックとして) ' ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」に素直に従うと、 ' 「顧客:」が見つからない場合は、この処理はスキップするべきか? ' それとも、元の `namePart` を使うべきか? ' 元の `namePart` は「名前:」と「顧客」の間。 ' ユーザーは「顧客:」の後ろを使いたいので、 ' 「顧客:」が見つからない場合は、この新しいロジックは適用しない。 ' その場合、元の `namePart` を使うか、あるいは処理をスキップするか。 ' ユーザーの要望は「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」なので、 ' 「顧客:」が見つからない場合は、この変更は適用されないと考えるのが自然。 ' よって、`namePart` は空にするか、あるいは元のロジックをそのまま使う。 ' ここは、`namePart` を一旦初期化し、新しいロジックで取得できなかったら空にする、という形が良いか。 namePartFromCustomer = "" ' 初期化 End If ' 取得した `namePartFromCustomer` を `namePart` として使う If namePartFromCustomer <> "" Then ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePartFromCustomer = Replace(namePartFromCustomer, " ", "") namePartFromCustomer = Replace(namePartFromCustomer, " ", "") ' ★ (北恵)の前にスペースを入れない ' 日付と名前の間だけ全角スペースを1つ残す ' folderName = datePrefix & " " & namePart & "様邸(北恵)" & tailText ' 修正:namePart を namePartFromCustomer に置き換える folderName = datePrefix & " " & namePartFromCustomer & "様邸(北恵)" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If End If ' If customerColonPos > 0 Then Else ' 「名前:」と「顧客」の間から `namePart` を取得する元のロジック ' この場合、`namePart` は「名前:」と「顧客」の間になる。 ' ユーザーの要望は「顧客:」の後ろなので、この元のロジックは使わない。 ' したがって、この `Else` ブロックは不要になる。 ' If p1 > 0 And p2 > p1 Then ... End If End If End If ' If p1 > 0 And p2 > p1 Then (元のコードのif文) コードの整理と再構築: 元のコードの If p1 > 0 And p2 > p1 Then ブロック全体を、新しいロジックに置き換える。 新しいロジックでは、「顧客:」を探し、その後の文字列を namePart として使用する。 ' 元のコードの該当部分 ' p1 = InStr(txt, "名前:") ' p2 = InStr(txt, "顧客") ' If p1 > 0 And p2 > p1 Then ' namePart = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) ' namePart = Trim(namePart) ' namePart = Replace(namePart, " ", "") ' namePart = Replace(namePart, " ", "") ' ' ... folderName 生成 ... ' End If ' 修正後のロジック Dim customerColonPos As Long Dim namePartToUse As String ' 最終的にフォルダ名に使う名前部分 Dim extractedName As String ' 「顧客:」から抽出した名前候補 ' まず「顧客:」を探す customerColonPos = InStr(txt, "顧客:") If customerColonPos > 0 Then ' 「顧客:」が見つかった場合 Dim startPos As Long startPos = customerColonPos + Len("顧客:") ' 抽出する文字列の終了位置を決定する ' もし「顧客」という単語が「顧客:」の後にある場合、その手前まで Dim customerWordPos As Long ' startPos から検索することで、「顧客:」より前の「顧客」を誤って探さないようにする customerWordPos = InStr(startPos, txt, "顧客") Dim endPos As Long If customerWordPos > 0 Then ' 「顧客:」の後ろに「顧客」という単語がある場合、その手前まで endPos = customerWordPos - 1 Else ' 「顧客」という単語がない場合、文字列の最後まで endPos = Len(txt) End If ' 抽出する文字列の長さを計算 Dim lenToExtract As Long lenToExtract = endPos - startPos + 1 If lenToExtract > 0 Then extractedName = Mid(txt, startPos, lenToExtract) extractedName = Trim(extractedName) ' extractedName には「ヤマダ」のような文字列が入る Else extractedName = "" ' 抽出できる文字列がない場合 End If ' 抽出した名前をフォルダ名に使用する If extractedName <> "" Then ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePartToUse = Replace(extractedName, " ", "") namePartToUse = Replace(namePartToUse, " ", "") ' ★ (北恵)の前にスペースを入れない ' 日付と名前の間だけ全角スペースを1つ残す folderName = datePrefix & " " & namePartToUse & "様邸(北恵)" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If Else ' 「顧客:」が見つからなかった場合、元のロジックで `namePart` を取得し、 ' それを `namePartToUse` として使用する。 ' 元のロジックは「名前:」と「顧客」の間を取得する。 ' ユーザーの要望は「顧客:」の後ろなので、この `Else` ブロックは、 ' 「顧客:」が見つからなかった場合のフォールバックとして、元のロジックを適用する。 Dim p1 As Long, p2 As Long p1 = InStr(txt, "名前:") p2 = InStr(txt, "顧客") ' ここで「顧客」という単語を探す If p1 > 0 And p2 > p1 Then ' 「名前:」と「顧客」の間を取得 namePartToUse = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) namePartToUse = Trim(namePartToUse) ' namePartToUse には「山田」のような文字列が入る ' namePartToUse が空でない場合のみ処理 If namePartToUse <> "" Then ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePartToUse = Replace(namePartToUse, " ", "") namePartToUse = Replace(namePartToUse, " ", "") ' ★ (北恵)の前にスペースを入れない ' 日付と名前の間だけ全角スペースを1つ残す folderName = datePrefix & " " & namePartToUse & "様邸(北恵)" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If End If End If さらにシンプルに: ユーザーの要望は「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」なので、 「顧客:」が見つからなかった場合は、元の「(北恵)」をそのまま使うのが最も自然。 つまり、namePartToUse を「顧客:」の後ろの文字列にする。 「顧客:」が見つからなかった場合は、namePartToUse は空にして、フォルダ名生成部分で If namePartToUse <> "" Then のようにチェックする。 ' 修正後のロジック(よりシンプルに) Dim customerColonPos As Long Dim namePartFromCustomer As String ' 「顧客:」から抽出した名前 ' まず「顧客:」を探す customerColonPos = InStr(txt, "顧客:") If customerColonPos > 0 Then ' 「顧客:」が見つかった場合 Dim startPos As Long startPos = customerColonPos + Len("顧客:") ' 抽出する文字列の終了位置を決定する ' もし「顧客」という単語が「顧客:」の後にある場合、その手前まで Dim customerWordPos As Long customerWordPos = InStr(startPos, txt, "顧客") Dim endPos As Long If customerWordPos > 0 Then endPos = customerWordPos - 1 Else endPos = Len(txt) End If ' 抽出する文字列の長さを計算 Dim lenToExtract As Long lenToExtract = endPos - startPos + 1 If lenToExtract > 0 Then namePartFromCustomer = Mid(txt, startPos, lenToExtract) namePartFromCustomer = Trim(namePartFromCustomer) ' namePartFromCustomer には「ヤマダ」のような文字列が入る Else namePartFromCustomer = "" ' 抽出できる文字列がない場合 End If End If ' namePartToUse を決定する Dim namePartToUse As String If namePartFromCustomer <> "" Then ' 「顧客:」から抽出できた場合、それを使用 namePartToUse = Replace(namePartFromCustomer, " ", "") namePartToUse = Replace(namePartToUse, " ", "") Else ' 「顧客:」が見つからなかった場合、元のロジックで取得した名前を使用する ' 元のロジックは「名前:」と「顧客」の間を取得する Dim p1 As Long, p2 As Long p1 = InStr(txt, "名前:") p2 = InStr(txt, "顧客") ' ここで「顧客」という単語を探す If p1 > 0 And p2 > p1 Then ' 「名前:」と「顧客」の間を取得 namePartToUse = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) namePartToUse = Trim(namePartToUse) ' namePartToUse には「山田」のような文字列が入る If namePartToUse <> "" Then namePartToUse = Replace(namePartToUse, " ", "") namePartToUse = Replace(namePartToUse, " ", "") End If Else ' 「名前:」も「顧客」も見つからなかった場合、namePartToUse は空のまま namePartToUse = "" End If End If ' フォルダ名の生成 If namePartToUse <> "" Then ' ★ (北恵)の前にスペースを入れない ' 日付と名前の間だけ全角スペースを1つ残す folderName = datePrefix & " " & namePartToUse & "様邸(北恵)" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If 最終的なコードの構造: 元の If Cells(i, col).DisplayFormat.Font.Bold = True Then の中の、 txt = Cells(i, col).Value の後から、folderName = CleanFileName(folderName) の前までを置き換える。 If Cells(i, col).DisplayFormat.Font.Bold = True Then txt = Cells(i, col).Value Dim p1 As Long, p2 As Long p1 = InStr(txt, "名前:") p2 = InStr(txt, "顧客") ' 「顧客」という単語の位置 Dim customerColonPos As Long customerColonPos = InStr(txt, "顧客:") ' 「顧客:」という文字列の位置 Dim namePartToUse As String ' 最終的にフォルダ名に使う名前部分 Dim extractedName As String ' 「顧客:」から抽出した名前候補 If customerColonPos > 0 Then ' 「顧客:」が見つかった場合、その後の文字列を優先的に使用する Dim startPos As Long startPos = customerColonPos + Len("顧客:") ' 抽出する文字列の終了位置を決定する ' もし「顧客」という単語が「顧客:」の後にある場合、その手前まで Dim customerWordPos As Long customerWordPos = InStr(startPos, txt, "顧客") Dim endPos As Long If customerWordPos > 0 Then ' 「顧客:」の後ろに「顧客」という単語がある場合、その手前まで endPos = customerWordPos - 1 Else ' 「顧客」という単語がない場合、文字列の最後まで endPos = Len(txt) End If ' 抽出する文字列の長さを計算 Dim lenToExtract As Long lenToExtract = endPos - startPos + 1 If lenToExtract > 0 Then extractedName = Mid(txt, startPos, lenToExtract) extractedName = Trim(extractedName) ' extractedName には「ヤマダ」のような文字列が入る Else extractedName = "" ' 抽出できる文字列がない場合 End If ' 抽出した名前をフォルダ名に使用する If extractedName <> "" Then ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePartToUse = Replace(extractedName, " ", "") namePartToUse = Replace(namePartToUse, " ", "") Else ' 「顧客:」は見つかったが、その後に名前がなかった場合 namePartToUse = "" End If ElseIf p1 > 0 And p2 > p1 Then ' 「顧客:」は見つからなかったが、「名前:」と「顧客」の間から取得する(元のロジック) namePartToUse = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) namePartToUse = Trim(namePartToUse) If namePartToUse <> "" Then ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePartToUse = Replace(namePartToUse, " ", "") namePartToUse = Replace(namePartToUse, " ", "") End If Else ' 「顧客:」も「名前:」と「顧客」の間も取得できなかった場合 namePartToUse = "" End If ' フォルダ名の生成(namePartToUse が空でない場合のみ) If namePartToUse <> "" Then ' ★ (北恵)の前にスペースを入れない ' 日付と名前の間だけ全角スペースを1つ残す folderName = datePrefix & " " & namePartToUse & "様邸(北恵)" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If End If ユーザーの要望の再確認: 「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」 例:顧客:ヤマダ→様邸(ヤマダ) この例は、フォルダ名が datePrefix & " " & namePartToUse & "様邸(北恵)" & tailText の形式であることを考えると、 namePartToUse の部分を「ヤマダ」にしたい、ということ。 そして、元のコードの namePart は「名前:」と「顧客」の間だった。 つまり、「名前:山田 顧客 △△」の場合、namePart は「山田 」だった。 ユーザーは「顧客:ヤマダ」という文字列から「ヤマダ」を取りたい。 修正後のコードでは、 まず「顧客:」を探す。 見つかったら、その後の文字列(例:「ヤマダ △△」)を extractedName として取得する。 extractedName を整形して namePartToUse にする。 もし「顧客:」が見つからなかったら、元のロジック(「名前:」と「顧客」の間)で namePartToUse を取得する。 このロジックで、ユーザーの要望「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」が実現できる。 つまり、namePartToUse の部分が、 「顧客:」が見つかれば、その後ろの文字列(例:「ヤマダ」) 「顧客:」が見つからなければ、元の「名前:」と「顧客」の間(例:「山田」) となる。 ただし、ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」は、 「様邸(北恵)」の「北恵」の部分を「ヤマダ」にしたい、という意図。 ということは、namePartToUse が「ヤマダ」になったら、 folderName = datePrefix & " " & namePartToUse & "様邸(北恵)" & tailText ではなく、 folderName = datePrefix & " " & namePartToUse & "様邸(" & namePartToUse & ")" & tailText としたい、ということか? いや、ユーザーの指示は「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」なので、 「(北恵)」の部分を「(ヤマダ)」のようにしたい、ということ。 つまり、 folderName = datePrefix & " " & namePartToUse & "様邸(" & namePartToUse & ")" & tailText という形式にしたい、と解釈するのが自然。 再修正: folderName の生成部分を修正する。 folderName = datePrefix & " " & namePartToUse & "様邸(北恵)" & tailText ↓ folderName = datePrefix & " " & namePartToUse & "様邸(" & namePartToUse & ")" & tailText これで、 「顧客:ヤマダ」が見つかれば namePartToUse は「ヤマダ」になる。 フォルダ名は 日付 ヤマダ様邸(ヤマダ)tailText となる。 もし「顧客:」が見つからず、元のロジックで namePartToUse が「山田」になった場合、 フォルダ名は 日付 山田様邸(山田)tailText となる。 この場合、元の「(北恵)」が消えてしまう。 ユーザーの意図を再解釈: 「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」 これは、「(北恵)」という固定文字列を、namePartToUse の値で置き換えたい、ということ。 つまり、 folderName = datePrefix & " " & namePartToUse & "様邸(" & namePartToUse & ")" & tailText この形が正しい。 コードの最終調整: namePartToUse を取得するロジックは上記で良さそう。 フォルダ名生成部分を修正する。 ' フォルダ名の生成(namePartToUse が空でない場合のみ) If namePartToUse <> "" Then ' ★ (北恵)の代わりに、取得した名前を使用する ' 日付と名前の間だけ全角スペースを1つ残す folderName = datePrefix & " " & namePartToUse & "様邸(" & namePartToUse & ")" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If この修正で、ユーザーの要望「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」が実現できる。 「顧客:ヤマダ」があれば namePartToUse は「ヤマダ」になり、フォルダ名は「日付 ヤマダ様邸(ヤマダ)tailText」となる。 「顧客:」がなく、「名前:山田 顧客 △△」なら namePartToUse は「山田」になり、フォルダ名は「日付 山田様邸(山田)tailText」となる。 これは、元のコードの「(北恵)」という固定文字列を完全に削除し、常に「様邸(取得した名前)」という形式にするということになる。ユーザーの例「顧客:ヤマダ→様邸(ヤマダ)」は、この解釈で合っているはず。 もし、元の「(北恵)」を残しつつ、 「顧客:ヤマダ」の場合のみ「様邸(ヤマダ)」とし、 それ以外は「様邸(北恵)」としたい、という場合は、 folderName 生成部分の If namePartToUse <> "" Then の中で、 さらに条件分岐が必要になる。 しかし、指示は「(北恵)のカッコ内の文字を"顧客:"の後ろの文字にして欲しい」なので、 「(北恵)」という固定文字を「"顧客:"の後ろの文字」で置き換える、と解釈するのが最も素直。 つまり、namePartToUse が「ヤマダ」なら「様邸(ヤマダ)」、 namePartToUse が「山田」なら「様邸(山田)」、という形。 コードの提示方法: 修正箇所を明確に示す。 修正後のコード全体を示す。 変更点の解説を加える。 コードのブロック: If Cells(i, col).DisplayFormat.Font.Bold = True Then の中の、 txt = Cells(i, col).Value の後から、 Next i の直前までを置き換える。 ' --- 修正開始 --- Dim p1 As Long, p2 As Long p1 = InStr(txt, "名前:") p2 = InStr(txt, "顧客") ' 「顧客」という単語の位置 Dim customerColonPos As Long customerColonPos = InStr(txt, "顧客:") ' 「顧客:」という文字列の位置 Dim namePartToUse As String ' 最終的にフォルダ名に使う名前部分 Dim extractedName As String ' 「顧客:」から抽出した名前候補 If customerColonPos > 0 Then ' 「顧客:」が見つかった場合、その後の文字列を優先的に使用する Dim startPos As Long startPos = customerColonPos + Len("顧客:") ' 抽出する文字列の終了位置を決定する ' もし「顧客」という単語が「顧客:」の後にある場合、その手前まで Dim customerWordPos As Long customerWordPos = InStr(startPos, txt, "顧客") Dim endPos As Long If customerWordPos > 0 Then endPos = customerWordPos - 1 Else endPos = Len(txt) End If ' 抽出する文字列の長さを計算 Dim lenToExtract As Long lenToExtract = endPos - startPos + 1 If lenToExtract > 0 Then extractedName = Mid(txt, startPos, lenToExtract) extractedName = Trim(extractedName) Else extractedName = "" ' 抽出できる文字列がない場合 End If ' 抽出した名前をフォルダ名に使用する If extractedName <> "" Then ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePartToUse = Replace(extractedName, " ", "") namePartToUse = Replace(namePartToUse, " ", "") Else ' 「顧客:」は見つかったが、その後に名前がなかった場合 namePartToUse = "" End If ElseIf p1 > 0 And p2 > p1 Then ' 「顧客:」は見つからなかったが、「名前:」と「顧客」の間から取得する(元のロジック) namePartToUse = Mid(txt, p1 + Len("名前:"), p2 - (p1 + Len("名前:"))) namePartToUse = Trim(namePartToUse) If namePartToUse <> "" Then ' ★ 名前の中の半角スペース・全角スペースをすべて削除 namePartToUse = Replace(namePartToUse, " ", "") namePartToUse = Replace(namePartToUse, " ", "") End If Else ' 「顧客:」も「名前:」と「顧客」の間も取得できなかった場合 namePartToUse = "" End If ' フォルダ名の生成(namePartToUse が空でない場合のみ) If namePartToUse <> "" Then ' ★ (北恵)の代わりに、取得した名前を使用する ' 日付と名前の間だけ全角スペースを1つ残す folderName = datePrefix & " " & namePartToUse & "様邸(" & namePartToUse & ")" & tailText folderName = CleanFileName(folderName) If folderName <> "" Then If Dir(basePath & folderName, vbDirectory) = "" Then MkDir basePath & folderName End If End If End If ' --- 修正終了 --- このコードブロックを、元のコードの If Cells(i, col).DisplayFormat.Font.Bold = True Then の中の、 txt = Cells(i, col).Value の後から、Next i の直前までにある、 If p1 > 0 And p2 > p1 Then ... End If の部分と置き換える。 元のコードの If p1 > 0 And p2 > p1 Then のブロックは、 namePart を取得し、folderName を生成している部分。 このブロック全体を、上記で作成した新しいロジックで置き換える。 ```vba' 元のコードの該当部分(置き [注意: 回答が長くなったため途中で切断されました。より具体的な質問で再度お試しください。]