サブフォルダ(データ)にある複数の.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
No.2ベストアンサー
- 回答日時:
No1です
補足をみましたが・・・
>Set cel = wbk.Worksheets("Sheet3").Cells(2, 1)
としているので、cel はA2セルを意味していることになります。
これに対して
>cel.Offset(-1, -1) = ~~
は、一つ上で、一つ左側のセルと言う意味になりますが、存在しないセルを指定していませんか?
確かに存在しないセルでした。ありがとうございます。別の問題に気がつきましたので考えて解決しないようなら改めて質問させてください。
ありがとうございました。
No.1
- 回答日時:
こんにちは
エラーの内容が示されていませんが「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
のような形にすれば、フォルダパスを取得できます。
(キャンセルの場合は空白文字列)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 集めたシートのシート名を変更したい。 下記のコードでサブフォルダにあるファイルのSheet3を集めて 6 2022/08/23 10:38
- Visual Basic(VBA) シートをコピーする下記記述でダイアログを用いた記述がわかりません?( A = Dir(ThisWor 4 2022/08/22 12:26
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Excel(エクセル) VBA フォルダ見える化のコードについて 2 2023/06/19 15:04
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Excel(エクセル) フォルダ内のワードファイルをPDFに一括変換するVBA 3 2023/06/09 16:51
- Visual Basic(VBA) ファイル名の右側を変更したい ファイル名:「1001日別売上」の左側へ「2022」を追加し、「202 6 2022/10/14 10:03
- Visual Basic(VBA) 入力ボックスが繰り返しポップアップして止まらない。 下記コードでファイル名の変更をしたいのですが、変 1 2022/09/08 11:27
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで複数のコメントのサ...
-
現在のブックを閉じないで、マ...
-
エクセル2010、図が大きすぎま...
-
バッチファイルのコピーで
-
アクセス クエリを別のファイ...
-
バッチファイル XCOPYで上書き...
-
Vba初心者です。下記のコード助...
-
Excel ハイパーリンク設定につ...
-
[エクセル]コピーするとオブジ...
-
ファイルサーバ上のファイルが...
-
frxファイルの役目
-
エクセルのファイル名をコピー...
-
エクセルVBAで開いているファイ...
-
vbsでExcelのシートをコピーす...
-
エクセルのマクロについて教え...
-
パワポでスライドをコピーでき...
-
Excel VBAで値コピーが使用でき...
-
バッチでサブフォルダ内のファ...
-
FTPとファイルコピーの違いにつ...
-
指定した時間になったらファイ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで複数のコメントのサ...
-
エクセルのハイパーリンクがコ...
-
バッチファイル XCOPYで上書き...
-
バッチファイル 別ファイルにリ...
-
frxファイルの役目
-
ファイルサーバ上のファイルが...
-
バッチファイルのコピーで
-
Vba初心者です。下記のコード助...
-
xcopyでのバッチコピー方法でコ...
-
同じファイル名 上書きしないフ...
-
エクセルVBAで開いているファイ...
-
エクセル2010、図が大きすぎま...
-
vbsでExcelのシートをコピーす...
-
アクセス クエリを別のファイ...
-
bat 同名ファイルコピー時にリ...
-
[エクセル]コピーするとオブジ...
-
ワード 一部のページだけをpdf...
-
パワポでスライドをコピーでき...
-
FSO.CopyFileでのエラー無視方法
-
VBSで作成したフォルダにファイ...
おすすめ情報
下記コードに書き換えたところ、別のデバッグとなりました。
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
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)
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
デバック箇所「cel.Offset(-1, -1) = Left(cel, O - 1)」
実行時エラー'1004'アプリケーション定義またはオブジェクト定義のエラーです。改善点をご教授頂けたませんでしょうか?よろしくお願いします。