| |
▼桜 さん：
こんばんは。
ちょろっと組替えてみました。
これで思っている通りの動作しますか？
Sub test()
Dim Mydir As String
Dim Filename As String
Dim mySh As String
Dim a As String
Dim myRng As Range
Dim i As Long
Dim n, ShtName, Flg
Dim AryFld()
Set Myfso = CreateObject("Scripting.FileSystemObject")
Set Sub_Fld = Myfso.GetFolder("C:\test").SubFolders
Redim Preserve AryFld(Sub_Fld.Count)
n = 1
ReDim AryFld(Sub_Fld.Count)
AryFld(0) = "C:\test"
n = 1
For Each Fld In Sub_Fld
AryFld(N) = Fld.Path
n = n + 1
Next
Set Sub_Fld = Nothing
Set Myfso = Nothing
For Each SchFld In Fld
'ファイル名を指定
Filename = Dir(SchFld & "\" & "*表.xls", VBnomal)
Do While Filename <> ""
'ファイルを開く
Workbooks.Open SchFld & "\" & Filename
'シートの有無を確認
ShtName = "VER5.0"
Flg = True
For n = 1 To Worksheets.Count
If StrConv(Worksheets(n).Name, vbUpperCase + vbNarrow) = ShtName Then
Flg = False
Exit For
End If
Next n
'シートVer5.0がある場合
If Flg = False Then
'MsgBox ShtName & "は存在します。"
'シートを選択
With Sheets("Ver5.0")
For i = 5 To .Range("j65536").End(xlUp).Row
If .Cells(i, "j").Value <> "" Then
.Cells(i, "j").Offset(, 1).Value = "OK"
End If
Next
End With
Workbooks(Filename).Save
Workbooks(Filename).Close
'シートVer5.0がない場合
Else
' MsgBox ShtName & "は存在しません。"
Workbooks(Filename).Close
End If
'End If
Filename = Dir()
Loop
Next
End Sub
|
|
kazu
- 05/2/24(木) 20:24 -
