• ベストアンサー

パラメターを複数リストアップし順番に処理

現在、以下のコードでcall1を呼び出して処理している。 Sub main() sub call1 FPath,SearchStr end sub パラメターのSearchStrを事前に複数リストアップして 順番に一つずつ読み込ませて自動で処理させるVBAのコードを以下のように卓上で考えてみました。 こんな感じで良いのでしょうか ? (卓上の案なので実際に試してはいません。) 改良案や別案など アドバイスいただければ嬉しいです。 Sub main() Dim FPath As String Dim SearchStr As Variant ' Set the folder path folderpath = "C:\TEST" SearchStr = Array("SearchString1", "SearchString2", "SearchString3") For Each str In SearchStr Call call1(FPath, str) Next str End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.3

配列を渡さずに質問のコードのようにstrを渡せばいいのではないでしょうか

NuboChan
質問者

お礼

最初の質問時のコードでミス記載していますが  Call call1(FPath, str) は、  Call call1(FPath, Serchstr) です。 旧コードでは、 RenameFilesInFolder folderPath, searchStr です。 >配列を渡さずに質問のコードのようにstrを渡せばいいのではないでしょうか この意味が良くわからないのですが。 str=Serchstrは、配列なのでSerchstrをそのまま渡せないのでは無いでしょうか? 考え方が間違っていますか ?

NuboChan
質問者

補足

頭を冷やして考えなおしました。 配列変数ではなく普通の変数にして引き継げば良いのですね。 以下で一応処理できているようですが  アドバイス有ればお願いします。 Sub main() Dim searchStr As Variant Dim folderPath As String Dim searchList As Variant Dim i As Long searchList = Array("[DELETE]", "[delete]", "【Delete】") ' 検索文字列のサンプルリスト folderPath = InputBox("検索するドライブを入力して下さい。", "ドライブレター_指定", "E:\") If folderPath = "" Then MsgBox "Cancelが入力されました。" Exit Sub End If For i = LBound(searchList) To UBound(searchList) searchStr = searchList(i) RenameFilesInFolder folderPath, searchStr Next i MsgBox "ファイル名の変更済み。" End Sub Sub RenameFilesInFolder(folderPath As String, searchStr As Variant)

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (3)

  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.4

> str=Serchstrは、配列なのでSerchstrをそのまま渡せないのでは無いでしょうか? この意味がよく分かりません。 Serchstrをそのまま渡せないのに(渡せるけど受け取る側でそのように設定していない) Call call1(FPath, Serchstr) になってました。 For EachでRangeなどのようなオブジェクトの塊をループした場合 オブジェクト変数にひとつずつオブジェクトとして渡されますが 配列の場合は、配列の要素がひとつずつ渡されます。 配列に関して参考にしてください。 【VBA】配列の要素を全て取り出せる!For Each〜Next文の使用方法【5分で理解】 https://goodtmrow.com/vba-repet-foreach-begginer/ なので For Each str In SearchStr Call call1(FPath, str) Next str でしたらFor Eachの部分で For i=xx ~NextのStr = SearchStr(i) と同じ事が行われているという感じです。 あと、プロシージャーの引数のByValとByRefを付けていませんが付けるようにした方がいいと思います。 省略すると「ByRef」となり、呼び出し先で値を変更すると元の値も変更されてしまいます。 配列などByRefでないと渡せないものもあります。

NuboChan
質問者

お礼

>呼び出し先で値を変更すると元の値も変更されてしまいます。 ありがとうございます。 質問者からの補足(2023/07/26 12:38)のように サブルーチン側で引く数が書き換わる可能性があるコードは利用していませんが 念には念でByValで固定すべく Sub RenameFilesInFolder(ByVal folderPath As String, ByVal searchStr As Variant) に変更しました。

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.2

Sub call1(FPPath As String, searchStr As Variant) じゃないと Call call1 (FPath, searchStr) のところでエラーになりませんでしょうか。 あと Call call1 (FPath, searchStr) でしょうか? 元が For Each str In SearchStr Call call1(FPath, str) Next str でした。

NuboChan
質問者

補足

すいません。 コードを全て開示しないとアドバイスが付けにくいと思うので 以下に現在の旧コードを記載します。 この旧コードを元に パラメターのSearchStrを事前に複数リストアップして 順番に一つずつ読み込ませて自動で処理させるコードに改良したいと思っています。 Sub main() Dim searchStr As String Dim folderPath As String searchStr = InputBox("ファイル名から削除する文字列を入力して下さい。", "削除文字列_指定") If searchStr = "" Then MsgBox "Cancelが入力されました。" Exit Sub End If folderPath = InputBox("検索するドライブを入力して下さい。", "ドライブレター_指定", "E:\") If folderPath = "" Then MsgBox "Cancelが入力されました。" Exit Sub End If RenameFilesInFolder folderPath, searchStr MsgBox "ファイル名の変更済み。" End Sub Sub RenameFilesInFolder(folderPath As String, searchStr As String) 'Dim folderPath As String 'Dim searchStr As String Dim file As Object Dim files As Object Dim fPath As Object ' フォルダーパスと検索文字列を指定 'folderPath = "E:" 'searchStr = "[DELETE]" '仮のサンプル ' フォルダー内の全てのファイルを取得 Set files = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).files Set fPath = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath) If (Not fPath.isRootFolder) And (fPath.Attributes And (FileAttribute.System + FileAttribute.Hidden)) Then Exit Sub ' ファイル名を変更(同名ファイルが存在する場合は()付きの番号を付加する) For Each file In files If InStr(file.Name, searchStr) > 0 Then Dim NewName As String Dim i As Integer i = 1 NewName = Replace(file.Name, searchStr, "") Do While Dir(file.ParentFolder & "\" & NewName) <> "" NewName = Replace(file.Name, searchStr, "") & "(" & i & ")" i = i + 1 Loop file.Name = NewName End If Next file For Each file In fPath.subFolders RenameFilesInFolder file.Path, searchStr Next End Sub

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.1

リストをコードの中で設定するのでしたら、通常そのような展開になると思いますから悪くないと思います。

NuboChan
質問者

お礼

kkkkkmさん、毎回お世話になっています。 今回もアドバイス感謝します。 改良前の以下のコードでは、  SeathStrは、inputboxで手動入力で一つだけを指定していたので  SearcStrは、Dim serchStr as StringとString型で定義していました。 Sub main() Dim serchStr as String call1 FPath,SearchStr end sub Sub call1(FPPath As String, searchStr As String) ’---------------------------------------------------------- SearchStrを複数使用するので改良版では Dim SearchStr As VariantとVariant型で定義に変更していますが、 Call call1 (FPath, searchStr)   (又は call call1 FPath,serachStr) Call先のcall1内の以下のコード  If InStr(file.Name, searchStr) > 0 Then  において  実行エラー:型が一致しません  となります。 searchStrをArrayで3個指定しているので searchStr(0),searchStr(1),searchStr(2)となりますが 配列変数なので If InStr(file.Name, searchStr) > 0 Then のコードではダメなのでどのように書き換えたら良いでしょうか ?

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • vbaの繰り返し処理について

    vbaです。 Sub Test1() Dim Str As String Dim Pnt1 As Long Dim Pnt2 As Long Str = Range("A1") Pnt1 = InStr(Str, "重 http://") If Pnt1 <= 0 Then Exit Sub Pnt2 = InStr(Pnt1, Str, "要") If Pnt2 <= 0 Then Range("B1") = Mid(Str, Pnt1 + 2) Else Range("B1") = Mid(Str, Pnt1 + 2, Pnt2 - (Pnt1 + 2)) End If End Sub という式でA1からA2.A3と下にURLが入っており空欄になるまで同じ処理をしたいのですがどのように変更すれば作動しますでしょうか?

  • 配列の参照渡しで型が一致しません。

    エクセル2003です。 いつもお世話になります。 以下のコードを実行すると「配列の型が一致しません。」というエラーが出ます。 typeNameで確認しても配列の型はvariant()で正しいと思うのですが。。。 皆様のお知恵を拝借させていただけないでしょうか。 -------------------------------------- Sub main() Dim e As Variant e = fuN() Call pRo(e)  '←ここでエラーになる。 End Sub Function fuN() As Variant Dim a(0) As Variant a(0) = "zero" fuN = a End Function Sub pRo(ByRef c() As Variant) '処理っす End Sub --------------------------------------

  • Excel VBA で処理中断(DoEvents)ができなくて困ってい

    Excel VBA で処理中断(DoEvents)ができなくて困っています。 まず、CommandButton1ボタンでSampleをコールし、Sample処理の中でループを廻し、途中でCommand1ボタンをクリックして、処理中断(DoEventsによって)をいれたいと思っています。 しかし、Command1ボタンをクリックしても処理中断がきかないのです。 グローバル変数fStopにはCommand1ボタンをクリックしたときにTrueが入っていることは、MsgBoxで確認していますが、Sample処理の方に値がつたわっていないようで、ループが最後まで止まりません。 コードが悪いのでしょうか、それとも、DoEventsの使い方が悪いのでしょうか。 もし、DoEventsが使えないのであれば、代替手段はありますでしょうか。 (長時間の印刷中の処理中断に応用したいと思っています) 環境はExcel 2002 SP3 , VB 6.0 , Windows XPです。 なお、DoEventsのコードは以下のURLを参考にして作成しました。 http://officetanaka.net/excel/vba/function/DoEvents.htm コードは以下のとおりです。 '********* Dim fStop As Boolean 'グローバル変数を宣言 '********* Sub Sample() Dim i As Long fStop = False For i = 1 To 1000000 DoEvents If fStop = True Then MsgBox "処理が中断されました" Exit For End If Next i End Sub '******** Private Sub CommandButton1_Click() Call Sample End Sub '******** Private Sub Command1_Click() fStop = True MsgBox "fStop=" & fStop End Sub

  • 割り込み処理

    Application.OnTimeで一定時間後に処理をさせたいのですが For文のループ処理を完了してからApplication.OnTimeが実行されてしまいます。 ループ処理中にApplication.OnTimeを優先して実行させることって出来るのでしょうか? Option Explicit Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long) Private Sub CommandButton1_Click() Call M1 End Sub Private Sub M1() Dim i As Integer Application.OnTime Now() + TimeValue("00:00:03"), "Sheet1.M2" For i = 0 To 30 Range("A1") = i Sleep 1000 Next i End Sub Sub M2() MsgBox ("123") End Sub

  • 【vba】「CStr」と「Str」は同じ意味ですか?

    Sub 数値を文字型に変更() Dim i As Long Dim moji As String i = 1 moji = CStr(i) moji = Str(i) End Sub 上記のコードで得られる結果は同じです。 "1"になります。 「CStr」でも「Str」でも数値を文字列に変換しています。 ということは「CStr」でも「Str」は同じなのですか? しかしコードの表示色が 「CStr」→キーワード 「Str」→識別子 です。 これが違うと言うことは何かが違うのでしょうか?  よろしくお願いします。

  • エクセル VBA リストボックス 一覧処理

    エクセル VBA リストボックス 一覧処理 シートから文字列を検索 ↓ リストボックス表示 ↓ 表示結果をクリック ↓ 空欄時入力 ↓ 更新 上記の流れをVBAで行いたいのですが、結果表示されたリストを選択 詳細を表示し、空欄においては都度入力した物を更新ボタンでセルへ 反映させるにはどの様にすればいいのでしょうか? Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim SAGASU As Object Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set SAGASU = Worksheets("2月") MaxRows = SAGASU.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = SAGASU.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub --------------- Private Sub UserForm_Initialize() Set SAGASU = Worksheets("2月") Maxl = SAGASU.UsedRange.Rows.Count End Sub --------------- Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As Object Namae = TextBox1.Text Set MeNamae = KensakuForm Call 検索(Namae, MeNamae) End Sub ---------------- Private Sub CommandButton2_Click() End End Sub ---------------- Private Sub ListBox1_Click() ListIdx = ListBox1.ListIndex Namae = ListBox1.List(ListIdx) End Sub 文字数制限の為、一部抜いていま

  • 同じ関数名やメソッド名は変数に使わない方が良い?

    例えば、Strと言うのは、オブジェクトブラウザで確認すると VBA.Conversion のメンバ にありますが、この場合、 Sub test() Dim Str As String Str = "test" MsgBox Str End Sub のようなコードは作らない方が良いのでしょうか? エラーになったり何か不都合が発生しますか?

  • FSOを使いサブフォルダのファイル操作

    同じ階層のサブフォルダにxlsm入るが入っており、VBAによりモジュールを解放しようと試みています。 まずは、FSOを使ってサブフォルダにアクセスしようとしましたが、下から6行目でエラー(424 オブジェクトが必要です)が出てしまい、解決できませんので、ご教示いただけないでしょうか? よろしくお願いします Sub DeleteMain() With Application.FileDialog(msoFileDialogFolderPicker) If Not .Show Then Exit Sub Call DeleteSub(folderPath:=.SelectedItems(1)) End With End Sub Sub DeleteSub(folderPath As String, Optional mycount As Long = 0) Dim fso As Object, myFolders As Object, myfile As Object Set fso = CreateObject("Scripting.FileSystemObject") Set myFolders = fso.GetFolder(folderPath).SubFolders For Each myfile In fso.GetFolder(folderPath).Files mycount = mycount + 1 ' Cells(mycount, 1) = myfile.Path Debug.Print myfile.Path Next For Each myFolders In fso.GetFolder(folder.Path).SubFolders Call DeleteSub(myFolder.Path, mycount) Next Set fso = Nothing Set myFolders = Nothing End Sub

  • vba pdfファイル順番に印刷

    セルC5から、下にファイル名が入っています。上から順に印刷したいのですが、下記だとvbaが動かないです。 Dim z As Object Dim i As Long Dim f, p As String Set z=CreateObject("WScript.Shell") p=Application.ActivePrinter For i=5 To Range("C1").End(xlDown).Row f="C:¥フォルダパス" & Cells(i,1).Value & ".pdf" ここから、行ごとに進んだ時に、黄色くならず反応しませんでした↓ If Dir (f)<>""Then z.Run("Acrobat.exe /t" & f) ↓ここにとびました。 Else End if Next i Set z=Nothing End Sub それ以前に、adobe acrobatが、更新されてから動いていたバッチファイルですら反応しなくなりました Adobeの環境設定をネットで見た通り見直ししたりしたのですが、全く成功しません。フォルダ内のpdfファイルを、全て印刷するvba(Acrobat.exe)を記載しない方法は成功したのですが、どうすれば、上手くいきますか? 教えていただきたいです。印刷の順番を指定したいです。 初心者なのでお手柔らかにお願いします。ちなみに動いているほうのvbaは下記です。 フォルダ内のファイルを全て印刷する、(順番関係なし)です。 Dim FolderPath As String Dim Filename As String Dim objShell As Object Dim objFolder As Object Dim objFile As Object FolderPath=ThisWorkbook.Path Set objShell=CreateObject("Shell.Application") Set objFolder=objShell.Namespace(ThisWorkbook.Path) For Each objFile In objFolder.items If Right(objFile.Name,4)=".pdf"Then objFolder.ParseName(objFile.Name) .InvokeVerbEx("print") End If Next objFile Set objFile=Nothing Set objFolder=Nothing Set objShell=Nothing End Sub 上記は全てネットから引用しています。 adobe acrobatを使うと反応しないので下記、上記に付け足ししたりして自身で初めて考えました。 Sub Test() Dim FolderPath As String Dim Filename As String Dim objShell As Object Dim objFolder As Object Dim objFile As Object FolderPath=ThisWorkbook.Path Set objShell=CreateObject("Shell.Application") Set objFolder=objShell.Namespace(ThisWorkbook.Path) For i=5 To Range("C1")End(xlDown).Row ObjFile.Name=FolderPath&Cells(i,1).value&".pdf" If Dir objFile.Name<>""Then objFolder.ParseName(objFile.Name).InvokeverbEx("print") Else End if Next i Set objFile=Nothing Set objFolder=Nothing Set objShell=Nothing MsgBox"印刷が完了しました" End Sub どこか文書変でしょうか?? 添削してくださいませんか。 順番に印刷、、できるとすごく仕事がはかどるため、成功させたいです。 お力添え、何卒お願いいたします。

  • 2010 excel マクロ 記号の変化

    エラー発生で強制終了になってしまいます。2007年のexcelで作成したものですが、2010だと強制終了になってしまいます。 内容は□をダブルクリックすると■になるように作っています。 記述は2003年からのマクロ記述なので、変化が必要なのでしょうか? Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'セルをダブルクリックすると、・→○→△→×→・と変更する。 Dim S1 As String Dim S2 As String Dim S01 As String Dim S02 As String Dim S03 As String Dim S04 As String S1 = "□" S2 = "■" S01 = "・" S02 = "○" S03 = "△" S04 = "×" On Error GoTo ERR_12 sCheckXY S1, S2 sCheckX1234 S01, S02, S03, S04 sChangeXY S1, S2 Exit Sub ERR_12: End End Sub Sub sChangeXY(X As String, Y As String) '選択セルに□があれば■に変える Dim Str0 As String 'str1の左端 Dim Str1 As String 'strの右側更新 Dim Str2 As String 'strの左側更新 Dim Str20 As String 'strの左側一部保存 Dim L As Long Dim M As Long Dim N As Long Str1 = ActiveCell.Text L = Len(Str1) Debug.Print L If L = 0 Then End End If For N = 1 To L Debug.Print Str2 Str0 = Left(Str1, 1) If Str0 = X Or N = L Then If Str20 <> "" Then If N = L Then Str20 = Str20 + Str0 End If If MsgBox(Str20 & "  はチェックしますか?", vbYesNo, "選択肢") = vbYes Then Str2 = Str2 + Replace(Str20, X, Y) Str20 = Str0 Else Str2 = Str2 + Replace(Str20, Y, X) Str20 = Str0 End If Else Str20 = Str0 End If Else Str20 = Str20 + Str0 End If Str1 = Right(Str1, L - N) Next N ActiveCell.Value = Str2 End Sub Sub sCheckXY(X As String, Y As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X Then ActiveCell.Value = Y End ElseIf ActiveCell.Text = Y Then ActiveCell.Value = X End End If End Sub Sub sCheckX1234(X1 As String, X2 As String, X3 As String, X4 As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X1 Then ActiveCell.Value = X2 End ElseIf ActiveCell.Text = X2 Then ActiveCell.Value = X3 End ElseIf ActiveCell.Text = X3 Then ActiveCell.Value = X4 End ElseIf ActiveCell.Text = X4 Then ActiveCell.Value = X1 End End If End Sub

専門家に質問してみよう