[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コードをわかりやすくしたい』（がんべーる）
ファイル名の文字列内に指定文字列がある場合、削除して変名するマクロです。
削除候補の指定文字列は、B4より下方向に事前に書き出しています。
Replace関数で削除文字があれば順番に削除するように考えました。
以下の部分は、
NewName = Replace(NewName, Target(i), "")
実際は、
NewName = Replace(OldName, Target(i), "") と書きたいのですが
For分でNewNameで順番に書き換え行くので
イコール(=)の左側も右側も同じNewNameとしていますが
見た目で納得できません。
なにか別の見て目でもすんなり理解できるようなコードがあれば教えてほしい。
Option Explicit
'
Private Sub Auto_Open()
Dim Fso As Object 'FileSystemObject
Dim Folder As Object 'Folder
Dim File As Object 'File
Dim FolderPath As String 'フォルダパス
Dim OldName As String '元のファイル名
Dim NewName As String '新しいファイル名
Dim Target As Variant '削除したい文字列 (配列)
Dim lc As Long
'FileSystemObjectを作成
Set Fso = CreateObject("Scripting.FileSystemObject")
'フォルダパスを指定
FolderPath = "C:\Users\TAC_\Downloads\"
'Folderオブジェクトを取得
Set Folder = Fso.GetFolder(FolderPath)
lc = Cells(Rows.Count, "B").End(xlUp).Row '最終行番号の取得
lc = lc - 3 '削除候補文字列候補はB4からなので個数調整の為調整
ReDim Target(1 To lc)
Dim i As Long
'削除したい文字列を指定
For i = 1 To lc
Target(i) = Cells(i + 3, "B").Value
Next
For Each File In Folder.Files
OldName = File.Name '元のファイル名を取得
NewName = OldName
For i = 1 To lc
'元のファイル名から削除したい文字列を除去
NewName = Replace(NewName, Target(i), "")
Next
If OldName <> NewName Then 'ファイル名が変更された場合
File.Name = NewName 'ファイル名を変更
End If
Next
MsgBox "変名完了 !!"
Set File = Nothing
Set Folder = Nothing
Set Fso = Nothing
End Sub
＜ 使用 Excel：Excel2021、使用 OS：Windows11 ＞
>と書きたいのですが 書き変えてなにか不具合でもあるんですか。 （???） 2024/01/21(日) 12:30:36
書き換えなくても現状で作動上は、不具合は無いと思いますが、
ただ、もう少し判りやすいコードの書き方があると思った訳です。
そう思うのは変ですか？
’・・・・・
（がんべーる） 2024/01/21(日) 13:05:38
私ならこう書きますかね。 Dim s As String と宣言しておいて、
For Each File In Folder.Files
s = File.Name '元のファイル名を取得
For i = 1 To lc
s = Replace(s, Target(i), "")
Next
File.Name = s 'ファイル名を変更
Next
（xyz） 2024/01/21(日) 13:12:49
以下が無いと変名する必要が無いファイルの場合エラーとなるので残しました。
If TempName <> File.Name Then
Dim TempName As String
For Each File In Folder.Files
TempName = File.Name '元のファイル名を仮ファイルとしてに取得
For i = 1 To lc
'仮ファイルファイル名から削除したい文字列を除去
TempName = Replace(TempName, Target(i), "")
Next
If TempName <> File.Name Then 'ファイル名が変更された場合
File.Name = TempName 'ファイル名を変更
End If
Next
（がんべーる） 2024/01/21(日) 13:34:37
(1)↓はいくつくらいが格納される見込みですか？ lc = Cells(Rows.Count, "B").End(xlUp).Row
(2)上記に関連して↓「lc」が１になることがありますか？また、1未満になることがあり得ますか？ lc = lc - 3
（もこな２） 2024/01/21(日) 14:25:36
変数名のネーミング方法については、色々と議論がされているかと思いますので全文検索するとよいかもしれません。
変数名にできるだけ意味をつけたほうがいい場合と、必ずしもそうでない場合もあります。
この場合、私が s とネーミングしたものは、一目でみてそれらが同じ変数であることのほうが重要な メッセージと言うこともあります。 こうした場合は、変数名に余り重いものは避け、軽い（短い）もののほうが望ましいと思いました。
これは繰り返しに使うカウンター変数なども同じですね。 i,j,k,l,m,n などの変数が好まれます。これをlnCounter1 などと書く人がたまにいますが、 余り賛成できないのと同じです。
逆に、変数の持つ意味が重要な場合は、それなりに内容説明的なものにします。（Java言語利用者ほど説明的には書きませんけど） （xyz） 2024/01/21(日) 15:07:33
----- 何点か確認。 ------
(1)↓はいくつくらいが格納される見込みですか？
現在、4つですが多くなるハズです。 先は判りませんが、２０程度だと思います。 （３桁になることは無いと思います。）
2)上記に関連して↓「lc」が１になることがありますか？
また、1未満になることがあり得ますか？
現在でも４なので1や1未満になる事はありません。 （１や１未満ではマクロにする意味さえ無くなってきます）
’==================================================
＞＞一目でみてそれらが同じ変数であることのほうが重要
すいません。
言わんとしている事が理解できていません。
今回の場合、個人的には
単純なループの為の変数(i,j,k等）ではく変数としては「処理用の仮のファイル名」との思いで
Dim TempName As String
としました。
（がんべーる） 2024/01/21(日) 15:32:00
Sub 研究用()
Const FolderPath As String = "C:\Users\TAC_\Downloads\"
Dim 配列 As Variant, buf As Variant
Dim File As Object
Dim NewName As String
With ActiveSheet
配列 = WorksheetFunction.Transpose(.Range("B4", .Cells(.Rows.Count, "B").End(xlUp)).Value)
End With
For Each File In CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath).Files
NewName = File.Name '元のファイル名を取得
For Each buf In 配列
NewName = Replace(NewName, buf, "")
Next buf
If File.Name <> NewName Then 'ファイル名が変更された場合
File.Name = NewName 'ファイル名を変更
End If
Next File
MsgBox "変名完了 !!"
Set File = Nothing
End Sub
（もこな２） 2024/01/21(日) 16:21:31
WorksheetFunction.Transpose を利用する方法をありがとうございます。
Redimを利用しないのですっきりしたコードになっていますが
以下が私には難しいので
配列 = WorksheetFunction.Transpose(.Range("B4", .Cells(.Rows.Count, "B").End(xlUp)).Value)
以下のように私が判りやすいように書き換えてみました。
作動的には問題ないようですが、ずいぶんコードが長くなってしまいました
思ったのですが「削除候補文字列群」はB4から下に連続して続いている（途中に空白が無い）ので
一つの塊として扱えれば最終セル番地の取得でのコードが短くなりそうだと思ったのですがどうでしょうか ？
(CurrentRegion, SpecialCells(xlCellTypeLastCell), UsedRange などを利用する ？）
ターゲットシートでB列は、「削除候補文字列群」専用で他は利用されていない
Dim LastRow, LastColumn As Long
Dim LastAdress
LastRow = Cells(Rows.Count, "B").End(xlUp).Row '削除候補文字列群の最終行番号'
LastColumn = Cells(4, Columns.Count).End(xlToLeft).Column '削除候補文字列群の最終列番号'
'削除候補文字列群の番地 -- Address
LastAdress = Cells(LastRow, LastColumn).Address
Dim DelMoji As Variant, buf As Variant
DelMoji = WorksheetFunction.Transpose(Range("B4", LastAdress))
（がんべーる） 2024/01/22(月) 09:18:52
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.