set文でエラーがでます

質問

以下のコードで
　実行エラー''9'「インデックスが有効範囲にありません。」が出る原因と対処方法を教えてください。

Set ws = Worksheets(FileName2)

FilewName2はローカルウインドウでは問題なく表示されています。

Sub 括弧及び括弧内文字削除()
'
'ダイアログでターゲットファイル（ｔｘｔ)を選択（読み込み) ---------------
Dim FileName As Variant
Dim FileName2 As String
Dim FilePath As String
Dim fso As New FileSystemObject

FileName = Application.GetOpenFilename(FileFilter:="Txtファイル,*.txt)
If FileName = False Then
Exit Sub
End If

'ターゲットファイルの拡張子無しのファイル名を取得
FileName2 = fso.GetBaseName(FileName)

'ターゲットファイルのパス取得
FilePath = Replace(FileName, Dir(FileName), "")
Workbooks.Open FileName

'括弧内文字列削除(括弧も含む）--------------------------------
Dim RegExp As Object
Dim Cell As Range
Dim tr As Long

'DATAを処理する行数
tr = Cells(Rows.Count, "A").End(xlUp).Row

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.Pattern = "[（(].*[)）]"
'
Application.ScreenUpdating = False

Dim buf
Dim i As Long

With Range("A1", Cells(Rows.Count, "A").End(xlUp))
buf = .Value
For i = 1 To UBound(buf)
buf(i, 1) = RegExp.Replace(buf(i, 1), "")
Next
.Value = buf
End With

' Range(Cells(1, 1), Cells(tr, 1)).Select
' For Each Cell In Selection
' Cell = RegExp.Replace(Cell, "")
' Next

'新規に修正ファイルをテキストファイルに書き出す -------------

Dim ws As Worksheet
Set ws = Worksheets(FileName2)

Dim datFile As String
datFile = FilePath & FileName2 & "_mod.srt"

Open datFile For Output As #1

For i = 1 To tr
Print #1, ws.Cells(i, "A").Value
Next

Close #1
Application.ScreenUpdating = True

MsgBox datFile & "に書き出しました" & vbCrLf & _
"処理が終了したのでEXCELを閉じて終了です。"

'// Excelを終了する
Application.Quit

ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Close SaveChanges:=False

End Sub

回答No.11

kkkkkm · ベストアンサー

> 保存(utf8)し起動させました。

こちらもUTF-8だとエラーになりました。
中に全角文字があるのでS-JISじゃないと駄目っぽいですね。
実行コードをワンクリックで実行できたらいいかもと思ってのVBS、VB.NETだったのですが
エクセルでも
Private Sub Workbook_Open()
にコードを書いてそこで最後にクローズしておけばワンクリックでできるので余談も余談でした。

補足

なるほど、ここでも文字コードの問題があるのですね。

こちらでもShift＿Jisで保存してエラーが出ないのを確認しました。
最後までお世話をおかけしました。

回答No.10

kkkkkm

回答No.6へのお礼を見る前に回答No.8を投稿してました

No.8の
それは無理な事だとなるとやばいので
は
私ができないとかになるとやばいので
という意味です。
なんかあとから読んだらNuboChanさんができないとやばいとも読めるなと思ったので訂正しておきます。

お礼

vbsのコードをありがとうございます。

せっかくコードをもらったので
kkkkkmさんもコードを「test.vbs」で保存(utf8)し起動させました。
添付画像のようなエラーが出てストップしました。

https://imgur.com/Qw1wXdK

VBAのようなローカルウインドウ等のエラー時に利用できる環境がVBSには無いようなので
DOSコマンド的に思えて初心者が簡単に手を出す事は出来そうにありません。

この件(VBS,VB.NET)は深追いしない方が良さそううです。

お世話になり今回も解決しました。

回答No.9

kkkkkm

FileName2 = fso.GetBaseName(FileName)

が2か所あるのはVBAからコピペした時に元々あったのがそのまま存在してるからで1カ所でいけます。

回答No.8

kkkkkm

> VBSとかVB.NETでやってしまえば

と言ってそれは無理な事だとなるとやばいのでVBSで試したら
ほぼVBAと同じでできました。
ファイルを開くダイアログだけはエクセルの力を借りないとできないみたいだったのですがあとはそのままコピペでした。
変数の型指定はできないみたいでした。

Option Explicit

Dim FileName
Dim FileName2
Dim buf
Dim fso
Dim RegExp
Dim FilePath
Dim datFile

FileName = SelectFile("srtファイル(*.srt),*.srt")

If FileName <> "" Then

Set fso = CreateObject("Scripting.FileSystemObject")

'拡張子無しのファイル名を取得
FileName2 = fso.GetBaseName(FileName)

'MsgBox FileName2

With fso.GetFile(FileName).OpenAsTextStream
buf = .ReadAll
.Close
End With

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.Pattern = "[（(].*[)）]"
buf = RegExp.Replace(buf, "")

FileName2 = fso.GetBaseName(FileName)

FilePath = fso.GetParentFolderName(FileName)

'Replace(FileName, Dir(FileName), "") Dirが使えなかったので↑のように

datFile = FilePath & "\" & FileName2 & "_mod.srt"

With fso.OpenTextFile(datFile, 2, True)
.Write buf
.Close
End With
Else
MsgBox "キャンセルされました"
End If

'https://yozda.exblog.jp/240328377/
'ファイルを開くダイアログ
Function SelectFile(sFilter)
Dim r: r = ""

On Error Resume Next
Dim objExcel
Set objExcel = CreateObject("Excel.Application")

Dim s
s = objExcel.GetOpenFilename(sFilter)
If VarType(s) <> vbBoolean Then r = s

objExce.Quit
On Error GoTo 0

SelectFile = r
End Function

回答No.7

kkkkkm

テキストファイルを直接操作する場合VBAでなくてもVBSとかVB.NETでやってしまえばいいような気もします。

回答No.6

kkkkkm

> 最初のアプローチでブックを作成する事にしたのが悪かったみたいで

そんなに悪くは無いと思います一行ずつセルに読み込むよりOpenだけでいいのでコードは短くなりますし。

> 「括弧削除.xlsm」のみで処理する方が良さそうだと考えるようになりました。

ファイルをbufに読み込んでそのまま RegExp.してしまうのが早いとは思います。
コードも短くなると思います。

こんな感じでいけそうです。

Sub Test()
Dim FileName As Variant
Dim buf As String
Dim fso As New FileSystemObject
Dim RegExp As Object
Dim FileName2 As String
Dim FilePath As String
Dim datFile As String

FileName = Application.GetOpenFilename(FileFilter:="Txtファイル/Srtファイル,*.txt;*.srt")
If FileName = False Then
Exit Sub
End If

With fso.GetFile(FileName).OpenAsTextStream
buf = .ReadAll
.Close
End With

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.Pattern = "[（(].*[)）]"
buf = RegExp.Replace(buf, "")

FileName2 = fso.GetBaseName(FileName)

FilePath = Replace(FileName, Dir(FileName), "")

datFile = FilePath & FileName2 & "_mod.srt"
With fso.OpenTextFile(datFile, 2, True)
.Write buf
.Close
End With

End Sub

お礼

他のブックを作成せずにテキストファイルをセルに書き出さずに一気に処理する方法をありがとうございます。

bufにに一気に読み込み、書き出す事が中々理解できずに時間がかかりました。

（ネットの情報を読み込んで何とかコードが少しは理解できるまでなりました。）

＞テキストファイルを直接操作する場合VBAでなくてもVBSとかVB.NETでやってしまえばいいような気もします。

ここで言う「VBS」とは、VBScriptの事ですよね。
「VB.NET」を含めて利用したことが無いので門外漢でほとんどEXCELのVBAで処理しています。
と言うか、昔、BASIC言語を少しやっただけの古い人間でそれ以外はむずかしそうで手が出せそうにありません。

Option Explicit

Sub 括弧及び括弧内の文字列削除_2()

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim FileName As Variant
'処理するテキストファイルを指定 (text,srt)
FileName = Application.GetOpenFilename(FileFilter:="Txtファイル/Srtファイル,*.txt;*.srt")
If FileName = False Then
Exit Sub
End If

Dim buf As String
'テキストファイル内の全ての文字を読み込みモード(1)でデータを一気に読み込む
With fso.GetFile(FileName).OpenAsTextStream(1)
buf = .ReadAll
.Close
End With

Dim RegExp As Object
Set RegExp = CreateObject("VBScript.RegExp")

'buf文字列中から括弧内の文字列（含む括弧）を削除して　---> bufに書き戻す
RegExp.Global = True
RegExp.Pattern = "[（(].*[)）]"
buf = RegExp.Replace(buf, "")

Dim FileName2 As String
Dim FilePath As String
FileName2 = fso.GetBaseName(FileName)
FilePath = Replace(FileName, Dir(FileName), "")

Dim datFile As String
datFile = FilePath & FileName2 & "_mod.srt"

'テキストファイルを開いて一気に書き込む
' 書き込みモード= 2
' 新たに作成するときは = True
' (書き込み)format = 0 ---> ASCIIファイルで書き出す
With fso.OpenTextFile(datFile, 2, True, 0)
.Write buf 'bufの内容を書き出す
.Close
End With

Set fso = Nothing

End Sub

回答No.5

kkkkkm

> しかし、以下のコードでエラー（実行エラー9：「インデックスが有効範囲
> にありません。」となります。
> Set wbs = wb.Worksheets(FileName)

シート名はFileName2なので
Set wbs = wb.Worksheets(FileName2)
じゃないとエラーになると思います。

FileName2を取得した後に記載してください。

以降のセル指定がwbsになっているみたいなので
その下の方に
Dim ws As Worksheet
Set ws = wb.Worksheets(FileName2)
がありますからそこを

Dim wbs As Worksheet
Set wbs = wb.Worksheets(FileName2)

にしてみたらいいと思います。

お礼

ありがとうございます。
アドバイスを元にコードを書き換えてエラー無く上手く処理できました。

1)「括弧削除.xlsm」起動
2)「括弧削除.xlsm」のModule1にある「Sub 括弧及び括弧内の文字列削除()」を実行
3) 「Set wb = Workbooks.Open(FileName)」で「SJ_test_001」ブックが作成されて
　　　「SJ_test_001」ブックのシート1の名前は、「SJ_test_001」となる
4)「FileName2 = fso.GetBaseName(FileName)」と
　「Set wbs = wb.Worksheets(FileName2)」でwbｓを取得
5)以下wbsシートを元に処理作業を行うのでwbs.となる

1) - 5) のように考えると思うのですがここで一つ疑問です。

初めに「括弧削除.xlsm」起動していますが
わざわざ「SJ_test_001」ブックを作成して「括弧削除.xlsm」は以後利用されていません。

「SJ_test_001」を作らずに「括弧削除.xlsm」のみで処理できるのではと考えました。
最初のアプローチでブックを作成する事にしたのが悪かったみたいで
「括弧削除.xlsm」のみで処理する方が良さそうだと考えるようになりました。

この考え方は的を得てますか？

Option Explicit
Sub 括弧及び括弧内の文字列削除()
'
'ダイアログでターゲットファイル（ｔｘｔ)を選択（読み込み) ---------------
Dim FileName As Variant
Dim FileName2 As String
Dim FilePath As String
Dim fso As New FileSystemObject

FileName = Application.GetOpenFilename(FileFilter:="Txtファイル/Srtファイル,*.txt;*.srt")
If FileName = False Then
Exit Sub
End If

Dim wb As Workbook
Set wb = Workbooks.Open(FileName)

'ターゲットファイルの拡張子無しのファイル名を取得
FileName2 = fso.GetBaseName(FileName)

Dim wbs As Worksheet
Set wbs = wb.Worksheets(FileName2)

'ターゲットファイルのパス取得
FilePath = Replace(FileName, Dir(FileName), "")

'括弧内文字列削除(括弧も含む）--------------------------------
Dim RegExp As Object
Dim Cell As Range
Dim tr As Long

'DATAを処理する行数
tr = wbs.Cells(Rows.Count, "A").End(xlUp).Row

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.Pattern = "[（(].*[)）]"
'
Application.ScreenUpdating = False

Dim buf
Dim i As Long
Stop

With wbs.Range("A1", wbs.Cells(Rows.Count, "A").End(xlUp))
buf = .Value
For i = 1 To UBound(buf)
buf(i, 1) = RegExp.Replace(buf(i, 1), "")
Next
.Value = buf
End With

' Range(Cells(1, 1), Cells(tr, 1)).Select
' For Each Cell In Selection
' Cell = RegExp.Replace(Cell, "")
' Next

'新規に修正ファイルを作成して削除結果をテキストファイルに書き出す -------------

Dim datFile As String
datFile = FilePath & FileName2 & "_mod.srt" '新規作成のファイル名

Open datFile For Output As #1

For i = 1 To tr
Print #1, wbs.Cells(i, "A").Value
Next

Close #1
Application.ScreenUpdating = True

MsgBox datFile & "に書き出しました。（同名ファイルがある場合は、上書き）" & vbCrLf & _
"処理が終了したのでEXCELを閉じて終了です。"

'// Excelを終了する
Application.Quit

ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Close SaveChanges:=False

End Sub

回答No.4

kkkkkm

Worksheets("SJ_test_001").Activate
はシートが存在するブックがアクティブになっていないと
「インデックスが有効範囲にありません。」
になると思います。

Dim wb As Workbook
Set wb = Workbooks.Open(FileName)

としたあとで

wb.Activate

とブックをアクティブにしておけば、それ以降他のブックやシートがアクティブにならない限り正常な結果になると思います。
ただ、わざわざアクティブにしなくても、新しくブックを開いたら他をアクティブにしない限りそれがアクティブになった状態のまま先に進むと思いますので、今回何故そうなったのか不思議な感じです。

なので、wb.Activateのあとで別のブック(マクロ実行しているブックとか)がアクティブになれば、同じような事になるのではないでしょうか。

ですので、ブックやシートがアクティブであることを前提にしない方が個人的にはいいのではと思います。

Dim wb As Workbook
Set wb = Workbooks.Open(FileName)
Dim ws As Worksheet
Set ws = wb.Worksheets(FileName2)

その後のセルアクセスはすべてws指定

みたいにしてアクティブ関係なしにしておくととりあえず安心かもしれません。

お礼

アドバイスありがとうございます。

どのシートにアクセスするのかはっきりさせるために
アドバイスを元に以下のように「括弧及び括弧内の文字列削除()」のコード見直してみました。

しかし、以下のコードでエラー（実行エラー9：「インデックスが有効範囲にありません。」となります。
Set wbs = wb.Worksheets(FileName)

どうもアドバイスが理解できていないようです。

Sub 括弧及び括弧内の文字列削除()
'
'ダイアログでターゲットファイル（ｔｘｔ)を選択（読み込み) ---------------
Dim FileName As Variant
Dim FileName2 As String
Dim FilePath As String
Dim fso As New FileSystemObject

FileName = Application.GetOpenFilename(FileFilter:="Txtファイル/Srtファイル,*.txt;*.srt")
If FileName = False Then
Exit Sub
End If

Dim wb As Workbook
Set wb = Workbooks.Open(FileName)

Dim wbs As Worksheet
Set wbs = wb.Worksheets(FileName)

'ターゲットファイルの拡張子無しのファイル名を取得
FileName2 = fso.GetBaseName(FileName)

Dim ws As Worksheet
Set ws = wb.Worksheets(FileName2)

'ターゲットファイルのパス取得
FilePath = Replace(FileName, Dir(FileName), "")

'Workbooks.Open FileName

'括弧内文字列削除(括弧も含む）--------------------------------
Dim RegExp As Object
Dim Cell As Range
Dim tr As Long

'DATAを処理する行数
tr = wbs.Cells(Rows.Count, "A").End(xlUp).Row

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.Pattern = "[（(].*[)）]"
'
Application.ScreenUpdating = False

Dim buf
Dim i As Long
Stop

With wbs.Range("A1", wbs.Cells(Rows.Count, "A").End(xlUp))
buf = .Value
For i = 1 To UBound(buf)
buf(i, 1) = RegExp.Replace(buf(i, 1), "")
Next
.Value = buf
End With

' Range(Cells(1, 1), Cells(tr, 1)).Select
' For Each Cell In Selection
' Cell = RegExp.Replace(Cell, "")
' Next

'新規に修正ファイルを作成して削除結果をテキストファイルに書き出す -------------

Dim datFile As String
datFile = FilePath & FileName2 & "_mod.srt" '新規作成のファイル名

Open datFile For Output As #1

For i = 1 To tr
Print #1, ws.Cells(i, "A").Value
Next

Close #1
Application.ScreenUpdating = True

MsgBox datFile & "に書き出しました。（同名ファイルがある場合は、上書き）" & vbCrLf & _
"処理が終了したのでEXCELを閉じて終了です。"

'// Excelを終了する
Application.Quit

ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Close SaveChanges:=False

End Sub

回答No.3

kkkkkm

あと
エラーになるコードで

Dim ws As Worksheet
Set ws = Worksheets(FileName2)

の前に

Debug.Print Worksheets(1).Name

として実際のシート名が何なのかを一応確認してみてはいかがでしょう。

お礼

アドバイスありがとうございます。

>エラーにはなりませんでした。

>SJ_test_001.srtがアクティブになっていないとエラーになりますが、
>他のブックがアクティブになるようなこともない感じなのですが

アドバイスを頂いて、よくよく考えてみるとエラーが出た時は
このマクロを起動するときに同時に他のexcelを起動していたような記憶があります。

ただ、参考画像を取ったときは他のシートを起動していなかったのですが
この時はエラーが出るかはチェックしませんでした。

今となっては再現性が無く、試しに他のexcelは起動しない単独の状態で
アドバイスにある修正をせずにマクロを実行するとエラーが出ませんでした。

このことより、エラー原因は他のexcelがアクティブになっていた可能性が大きいです。

このマクロは、単独が基本ですが他のexcelを同時に起動させる事もあるかも知れないので
今回の場合は、(SJ_test_001)ですがこのシートをアクティブにする
以下のようなコードを追加すれば不具合は解消しますか　？

Worksheets("SJ_test_001").Activate

回答No.2

kkkkkm

> FileName2と同じ名前のシートは存在します。

すみません確認不足でした実行してみたら確かにシートが存在しました、ただエラーにはなりませんでした。
SJ_test_001.srtがアクティブになっていないとエラーになりますが、他のブックがアクティブになるようなこともない感じなのですが

とりあえず念のために

Workbooks.Open FileName

のすぐ後に

Dim ws As Worksheet
Set ws = Worksheets(FileName2)

とするとか

Workbooks.Open FileName

のところをがちがちにかためて

Dim wb As Workbook
Set wb = Workbooks.Open(FileName)
Dim ws As Worksheet
Set ws = wb.Worksheets(FileName2)

とかにしておいて

その後のセルアクセスはすべてws指定にしておけばいかがでしょう。

回答No.1

kkkkkm

FileName2と同じ名前のシートが無いのではないでしょうか。

お礼

kkkkkmさん、毎度おせわになります。

FileName2と同じ名前のシートは存在します。

以下の参考画像を見てください。
https://imgur.com/d5P8i3o

括弧削除.xlsmを起動直後は①の状態です。
括弧削除.xlsm内のマクロを起動して
　以下のようにStopで停止した時点の状態では②のようになります。

'新規に修正ファイルをテキストファイルに書き出す -------------
Stop
Dim ws As Worksheet

アドバイスの内容が理解できていないのでとんちんかんな回答であればすいません。
ご指導ください。