[[20220814154746]]　『セルの値を切り出したい』（たかこ）　ページの最後に飛ぶ

『セルの値を切り出したい』（たかこ）

サブフォルダ（データ）にある複数の.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

＜使用 Excel：Office365、使用 OS：Windows10 ＞

１行前に
Worksheets("Sheet3").Select
を追加してみてください。

（マナ） 2022/08/14(日) 15:59

本来は、Selectしない記述を目指してください。
Selectするからエラーになるのです。
そのためには、セルやブックを、変数にSetします

 Sub コード商品切り出し()
    Dim FolderName As String '文字列を入れる変数として「FolderName」を使う
    Dim index As Integer '数字を入れる変数として「index」を使う
    Dim FileName As String '文字列を入れる変数として「FileName」を使う
    Dim wbk As Workbook
    Dim cel As Range
    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 <> "" ' ファイルがなくなるまで繰り返す
        Set wbk = Workbooks.Open(FolderName & FileName) 'ファイルを開く
        Set cel = wbk.Worksheets("Sheet3").Cells(2, 1)
        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.Save True
        FileName = Dir() '
    Loop

 End Sub

（マナ） 2022/08/14(日) 16:11

訂正

 ＞wbk.Save True
    ↓
   wbk.Close True

（マナ） 2022/08/14(日) 16:14

ありがとうございます。一歩前進しました。
今度は、「cel.Offset(-1, -1) = Left(cel, O - 1)」でデバックとなり、複数ある.xlsxファイルの1つ目のB2セルだけ正常にコピーされていました。ループする途中でエラーになったのでしょうか？
引き続きの質問で恐縮ですがご教授いただけませんでしょうか？よろしくお願いいたします。
（たかこ） 2022/08/14(日) 16:54

エラーで止まった状態で
Oに、マウスカーソルを当ててみてください

（マナ） 2022/08/14(日) 17:08

カーソルを当てたら、O=7 となっています。

またデバック箇所のエラーは、

実行時エラー'1004'
アプリケーション定義またはオブジェクト定義のエラーです。

どのようにしたら改善するかご教授いただけませんでしょうか？よろしくお願いいたします。
（たかこ） 2022/08/14(日) 17:19

Cells(2, 1) の　Offset(-1, -1) ??

（マナ） 2022/08/14(日) 17:26

こうですね

        cel.Offset(-1, 1) = Left(cel, O - 1)
        cel.Offset(-1, 2) = Right(cel, P)

（マナ） 2022/08/14(日) 18:16

ありがとうございます。セルが無いところを指定していたのですね！
（たかこ） 2022/08/15(月) 09:37

コメント返信：

[ 一覧(最新更新順) ]

[[20220814154746]] 『セルの値を切り出したい』（たかこ） ページの最後に飛ぶ

[[20220814154746]]　『セルの値を切り出したい』（たかこ）　ページの最後に飛ぶ