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

こんにちは。


(1)master.xlsxを100回複製して、それぞれのファイル名を"検索したい文字"とする。

(2)コピーしてできた100個のファイルを、「ブック内のすべてのワークシートに対して、"検索したい文字"以外の行を削除する。」
("検索したい文字"は、vbaを実行するExcelファイルのA列に100つ記載している。)

上記のようなことがしたく、コードを書いたつもりでいますが、上手くいきません・・・。

当方はvba超初心者です。
そのため、非常に見にくいコードになっているかと思います。何卒ご容赦ください。
また、上記の(1)、(2)の説明も不十分なのも承知しております。何卒ご容赦ください。

残業時間を減らすべくvbaを書いて試行錯誤しておりますが、苦戦しております。
どなたか教えていただけないでしょうか(汗)


----------
Public Sub Test()
Dim s As Long
Dim name As String
Dim sh As Worksheet
Dim i As Long
Dim ex As New Excel.Application
Dim wb As Workbook
Dim sPath

For s = 1 To 100   '100つの検索したい文字を参考にする
name = Sheet1.Cells(s, 1).Value
FileCopy "C:\Users\●●●●\Desktop\master\master.xlsx", "C:\Users\●●●●\Desktop\all\" & name & ".xlsx"

sPath = "C:\Users\●●●●\Desktop\all\" & name & ".xlsx"
Set wb = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)

For Each sh In wb.Worksheets
For i = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row To 2 Step -1
If InStr(sh.Cells(i, "B"), "name") = 0 Then
sh.Rows(i).Delete
End If
Next i
Next sh
wb.Save
Call wb.Close
Next

End Sub

----------

gooドクター

A 回答 (3件)

#1,2 です。

連投すみません。
気になって読み返してコードをデバッグしてみました。
1,Dim ex As New Excel.Application は新たにExcelを開いているようですが、Excel以外のApplicationから実行するのでしょうか?
2013からSDIに変更されたことにより、exがあると少し扱いが難しくなるような気がします。
なのでExcelから実行しExcelBookを開くのならインスタンスを変えず
ex.は付けない方が良いと思います。。。
って何言っているか解らないと思いますが、Dim ex As New Excel.Applicationとex.は不要では無いかと思います。

いずれにしても、エラー発生の可能性がいくつか予測できます。
allフォルダに既に同名ファイルがある場合
nameが ""だった場合
そのあたりの処理をどうするか、、処理しないようにするとか
先にある同名ブックを削除するとか、、、
もっとも 絶対発生しないのなら、良いのですが、、、どうでしょう。

非常に投稿するか悩んだのですが、

Public Sub Test1()
Dim sh As Worksheet
Dim keyCell As Range
Dim DelRows As Range
Dim R As Range
Dim DesktopPath As String
Dim sPath As String
DesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Application.ScreenUpdating = False
For Each keyCell In Sheet1.Range("A1:A100")
'100つの検索したい文字を参考にする
If keyCell.Value <> "" Then
sPath = DesktopPath & "\all\" & keyCell.Value & ".xlsx"
If Not Dir(sPath) <> "" Then
FileCopy DesktopPath & "\master\master.xlsx", sPath
With Workbooks.Open(Filename:=sPath)
For Each sh In .Worksheets
For Each R In sh.Range("B2", sh.Cells(sh.Rows.Count, "B").End(xlUp))
If InStr(R.Value, keyCell.Value) = 0 Then
If DelRows Is Nothing Then
Set DelRows = R.EntireRow
Else
Set DelRows = Union(DelRows, R.EntireRow)
End If
End If
Next
If Not DelRows Is Nothing Then DelRows.Delete
Set DelRows = Nothing
Next sh
.Close SaveChanges:=True
End With
End If
End If
Next
Application.ScreenUpdating = True
End Sub

>残業時間を減らすべくvbaを書いて試行錯誤しておりますが
私は若いころ、さぼる為(言い方替えます。時間を作る為)にVBAを書き始めました。
サンプルを書きましたが
処理時間を考えて違う書き方にしましたので参考にならないかも知れません。
    • good
    • 0

あとこれも


wb.Save
Call wb.Close なので(別名で保存でないようなので)
UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
読み取り専用で開いているようですが、、行を削除していますね。
なので、上記は不要では無いかな?
Set wb = ex.Workbooks.Open(Filename:=sPath)

更に
wb.Save
Call wb.Close
は、
wb.Close SaveChanges:=True
でどうでしょう。
    • good
    • 0

こんばんは、


されたい事をちゃんと租借できていませんが、
ぱっと見で取り敢えず回答します。

If InStr(sh.Cells(i, "B"), "name") = 0 Then

この"name"は name = Sheet1.Cells(s, 1)で取得した値を使用したいのでは、、、とすると
If InStr(sh.Cells(i, "B"), name) = 0 Then  となります。
    • good
    • 0

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

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

gooドクター

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

人気Q&Aランキング