プロが教える店舗&オフィスのセキュリティ対策術

サブフォルダ(データ)にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2セルへコピーし、アンダーバーより左の値をB1セルへコピーし、右をC1セルへコピーしたい。下記コードを実行すると「Worksheets("Sheet3").Cells(2, 1).Select」でデバックになります。何処を修正したら良いか教えてください。よろしくお願いいたします。
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub コード商品切り出し()
Dim FolderName As String '文字列を入れる変数として「FolderName」を使う
Dim index As Integer '数字を入れる変数として「index」を使う
Dim FileName As String '文字列を入れる変数として「FileName」を使う
Dim N As Long
Dim O As Long
Dim P As Long
FolderName = Application.GetOpenFilename 'ダイアログを用いて選択したファイルのパスをFolderNameとする①
If FolderName = "False" Then 'FolderNameが選択されていなければ作業を終了する
Exit Sub
End If
'今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。
index = InStrRev(FolderName, "\") 'フォルダ名部分の文字数をカウントする
FolderName = Left(FolderName, index) ' カウントした文字数までの部分を切り取ってフォルダ名とする
FileName = Dir(FolderName & "*xlsx") ' フォルダの中に含まれるファイルを取り出す
Do While FileName <> "" ' ファイルがなくなるまで繰り返す
Workbooks.Open FolderName & FileName 'ファイルを開く

Worksheets("Sheet3").Cells(2, 1).Select

N = InStr(ActiveCell, "01")
O = InStr(ActiveCell, "_")
P = InStr(ActiveCell, "_")
ActiveCell.Offset(0, 1) = Left(ActiveCell, N - 1)
ActiveCell.Offset(-1, -1) = Left(ActiveCell, O - 1)
ActiveCell.Offset(-1, 0) = Right(ActiveCell, P)

Workbooks(Workbooks.Count).Save
Workbooks(Workbooks.Count).Close
FileName = Dir() '
Loop
End Sub

「サブフォルダ(データ)にある複数の.xl」の質問画像

質問者からの補足コメント

  • 下記コードに書き換えたところ、別のデバッグとなりました。
    Sub コード商品切り出し2()
    Dim FolderName As String
    Dim index As Integer
    Dim FileName As String
    Dim wbk As Workbook
    Dim cel As Range
    Dim N As Long
    Dim O As Long
    Dim P As Long

      補足日時:2022/08/14 17:31
  • FolderName = Application.GetOpenFilename
    If FolderName = "False
    Exit Sub
    End If
    index = InStrRev(FolderName, "\")
    FolderName = Left(FolderName, index)
    FileName = Dir(FolderName & "*xlsx")
    Do While FileName <> ""
    Set wbk = Workbooks.Open(FolderName & FileName) 'ファイルを開く
    Set cel = wbk.Worksheets("Sheet3").Cells(2, 1)

      補足日時:2022/08/14 17:33
  • N = InStr(cel, "01")
    O = InStr(cel, "_")
    P = InStr(cel, "_")
    cel.Offset(0, 1) = Left(cel, N - 1)
    cel.Offset(-1, -1) = Left(cel, O - 1)
    cel.Offset(-1, 0) = Right(cel, P)
    wbk.Close True
    FileName = Dir() '
    Loop
    End Sub

      補足日時:2022/08/14 17:34
  • デバック箇所「cel.Offset(-1, -1) = Left(cel, O - 1)」
    実行時エラー'1004'アプリケーション定義またはオブジェクト定義のエラーです。改善点をご教授頂けたませんでしょうか?よろしくお願いします。

      補足日時:2022/08/14 17:35
教えて!goo グレード

A 回答 (2件)

No1です



補足をみましたが・・・

>Set cel = wbk.Worksheets("Sheet3").Cells(2, 1)
としているので、cel はA2セルを意味していることになります。
これに対して

>cel.Offset(-1, -1) = ~~
は、一つ上で、一つ左側のセルと言う意味になりますが、存在しないセルを指定していませんか?
    • good
    • 0
この回答へのお礼

確かに存在しないセルでした。ありがとうございます。別の問題に気がつきましたので考えて解決しないようなら改めて質問させてください。
ありがとうございました。

お礼日時:2022/08/14 20:13

こんにちは



エラーの内容が示されていませんが「Selectメソッドが失敗しました」という内容のものでしょうか?

であるなら、対象シートがアクティブになっていないことが原因ではないかと想像されます。
ブックを開くと、前回保存時のシートがアクティブになると思いますけれど、それがSheet3ではない場合に、ご提示のメソッドはエラーになります。

現状のままで処理したければ、
>Worksheets("Sheet3").Cells(2, 1).Select
の前に
 Worksheets("Sheet3").Activate
を入れておけば、エラーは出なくなるでしょう。
(Sheet3が存在していることが条件です。存在しなければエラーになります)


なお、ご質問には直接関係ありませんけれど・・
・複数のブックを扱う場合には、ブックを明示した記述にしておく方が、間違えは少なくなります。
・SelectやActiveCellを用いずに、Rangeを利用すれば、直接読み書きが可能ですので、シートをActiveにする必要はなくなります。
 With Worksheets("Sheet3").Cells(2, 1)
  N = InStr(.Text, "01")
    ~~
  .Offset(0, 1).Value = Left(.Text, N - 1)
    ~~
 End With
といった具合。
・ファイルダイアログを用いていますが、実際にはフォルダを指定するのが目的のようですので・・
 Dim FolderPath As String
 With Application.FileDialog(msoFileDialogFolderPicker)
  If .Show = True Then FolderPath = .SelectedItems(1)
 End With
のような形にすれば、フォルダパスを取得できます。
(キャンセルの場合は空白文字列)
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング