[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『プロパティまたはメソッドをサポートしていません』（やわら）
タイトル通りのエラーが出ますが、なぜ出るのか分からずお助けいただきたいです。
ほかのサイト見ても、記述の方法間違ってる部分が分からなくて…
＞wb_moto.ws_moto.Range("M" & i & ":N" & i).PasteSpecial Paste:=xlPasteValues
ここの部分でエラーが出ます。
Option Explicit
Sub maxmin()
Dim fso As Object
Dim file As Object
Dim mydir As String
Dim wb_moto As Object
Dim ws_moto As Worksheet
Dim i As Long
i = 2
Set fso = CreateObject("Scripting.FileSystemObject")
mydir = ActiveWorkbook.Path
Set wb_moto = ThisWorkbook
Set ws_moto = ActiveSheet
For Each file In fso.getFolder(mydir).Files
If fso.getfilename(file.Name) Like Range("A" & i) & "*" Then
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=file, ReadOnly:=False)
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.Name Like "*基準値" Then
ws.Range("A1").Value = "=MIN(B2:DQ81)"
ws.Range("B1").Value = "=MAX(B2:DQ81)"
ws.Range("A1:B1").Copy
If ws.Name Like "*A*" Then
wb_moto.ws_moto.Range("G" & i & ":H" & i).PasteSpecial Paste:=xlPasteValues
ElseIf ws.Name Like "*B*" Then
wb_moto.ws_moto.Range("I" & i & ":J" & i).PasteSpecial Paste:=xlPasteValues
ElseIf ws.Name Like "*C*" Then
wb_moto.ws_moto.Range("K" & i & ":L" & i).PasteSpecial Paste:=xlPasteValues
Else
wb_moto.ws_moto.Range("M" & i & ":N" & i).PasteSpecial Paste:=xlPasteValues
End If
End If
Next
'ファイルを閉じる
wb.Close SaveChanges:=True
End If
i = i + 1
Next
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
＞wb_moto.ws_moto.Range("M" & i & ":N" & i).PasteSpecial Paste:=xlPasteValues
それは
ws_moto.Range("M" & i & ":N" & i).PasteSpecial Paste:=xlPasteValues
で良いと思いますよ。
ws_motoには、親（book）の情報も持っていますので、ダブルで指定する必要がありません。
wb_motoというブックは、ws_motoというプロパティは持っていません。
（xyz） 2023/07/04(火) 14:25:44
そうですね。 上記の書き方だとOKです。 なかなか良い質問で、もっと詳しい説明があると思います。# 出かける予定がありまして。 （xyz） 2023/07/04(火) 14:46:50
拙い解説です。
Workbooks は複数形のsが付いていますよね。
これはWorkbookコレクションで、Workbookの集まりです。
("何とかブック") と、インデックスを与えると、
ブック群の中の何とかブック、と指定しています。
>Workbooks("貼り付けしたいファイル名").Sheets("貼り付けしたいシート").Range("貼り付けたいセル")
↑は、 数あるブックの中の"貼り付けしたいファイル名"ブックの、 数あるシートの中の"貼り付けしたいシート"シートの、 数あるセルのなかの"貼り付けたいセル"範囲のセル となります。
こちらを一読すれば、イメージは出来るかと。 https://vba-beginner.com/vba2-7-4009/
（tkit） 2023/07/04(火) 15:34:52
＞fso.getFolder(mydir).Filesのループが終わりません。
プログラム見てないけど、そりゃ典型的な「無限ループ」ってやつかと。
どうなったら終わっていいのか（終了条件、と呼ぶ）を設定してあげよう。
（ufj） 2023/07/04(火) 15:56:01
無限ループについてですが、
＞For Each f In fso.GetFolder(mydir).Files
この記述の意味を「FSOで取得したフォルダの中にあるファイルの数分ループする」だと思っていたので
無限ループしないはずと思って書いていました。
ループしている以上認識が違うのだと思いますが、調べた範囲だと同じような書き方をしているものしか見つけられませんでした。
何が違うのかを教えていただきたいです。
（やわら） 2023/07/04(火) 16:06:48
同じファイルが取得していますか？
Debug.Print f.Path で、 イミディエイトに出力して確認してください。
ファイルが全て取得したのに、ループが止まらない のであれば、隠しファイルも取得するので、それかも。
無限ループなのであれば、提示のコードとは何かが違うかと。 （tkit） 2023/07/04(火) 16:18:21
Sub maxmin()
Dim fso As Object
Dim f As Object
Dim mydir As String
Dim wb_moto As Object
Dim ws_moto As Worksheet
Dim i As Long
i = 3
Set fso = CreateObject("Scripting.FileSystemObject")
mydir = ThisWorkbook.Path
Set wb_moto = ThisWorkbook
Set ws_moto = ActiveSheet
Range("A:A").Clear
For Each f In fso.GetFolder(mydir).Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsx" Then
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=f, ReadOnly:=False)
ws_moto.Range("A" & i) = wb.Name
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.Name Like "*基準値" Then
ws.Range("A1").Value = "=MIN(B2:DQ81)"
ws.Range("B1").Value = "=MAX(B2:DQ81)"
ws.Range("A1:B1").Copy
If ws.Name Like "*A*" Then
ws_moto.Range("G" & i & ":H" & i).PasteSpecial Paste:=xlPasteValues
ElseIf ws.Name Like "*B*" Then
ws_moto.Range("I" & i & ":J" & i).PasteSpecial Paste:=xlPasteValues
ElseIf ws.Name Like "*C*" Then
ws_moto.Range("K" & i & ":L" & i).PasteSpecial Paste:=xlPasteValues
Else
ws_moto.Range("M" & i & ":N" & i).PasteSpecial Paste:=xlPasteValues
End If
End If
Next ws
'ファイルを閉じる
wb.Close SaveChanges:=True
End If
i = i + 1
Next f
Set fso = Nothing
End Sub
（やわら） 2023/07/04(火) 16:34:53
前半部分だけですが、コメントしておきます。
既に適切なコメントをいただいていますが、念のため。
(1)
Set wb_moto = ThisWorkbook
Set ws_moto = ActiveSheet
(なお、これはActivWorkbookのActivesheetという意味。
ThisWorkbookがActiveになっているんだろうけど、そうでない場合もありうるので要注意）
変数を指定するとき、ws_motoの親であるBookは明確に決まっています。
実際、ステップ実行して、"ローカルウインドウ"で ws_motoのプロパティを見てください。 Parentプロパティというものがあり、親のBookが一意に決まっていることがわかります。
したがって、ws_motoと書けば、どのブックのシートかということは"織り込みずみ"であり、 「ブックは指定する必要がない」というのが第一のポイントです。
(2) wb_moto.ws_moto と書けば、ブック - シートという階層構造に則っているから問題ないだろう、 と考えるかもしれませんが、それはws_motoの中身を貴方が知っているからです。 構文解析上、ws_motoを(Activesheetといった）シート情報に読み替えて、 という操作を行えば、それは可能ですが、そういう作りにはなっていない（と想像される）。 つまりは、VBAの作者が構文解析の仕組みをそのように決めており、 そういうことはできない、ということです。 これが第二の理由です。 (3) wb_motoは、ws_motoという変数をプロパティに持ってはいない、は既に書きました。
（xyz） 2023/07/04(火) 17:09:54
>なぜか2行開けてまたループしてしまいます。 ２行の空白行は、そのフォルダに拡張子がxlsxではないファイルが２つあるんでしょうね すくなくともこのマクロが記述されたファイル(.xlsm) ともう一つなにか
ローカルディスクにテスト用のフォルダ作って実行したら同じようになりますか？ （´・ω・`） 2023/07/04(火) 18:31:00
（´・ω・`）さんもありがとうございます。
xlsmと、実行中の一時ファイルがいるので多分それです。
テストフォルダだと正常に完了しました。
元々作業していた場所がSSD上だったから問題が起きていたのかもしれません…？
（やわら） 2023/07/05(水) 12:22:39
>テストフォルダだと正常に完了しました。 ということは、コードの問題ではなく、フォルダの方に問題があるようですね
ネットワークのフォルダなのかなと思ったのですが、 >元々作業していた場所がSSD SSDでもHDDでも違いはないと思いますが、不思議ですね （´・ω・`） 2023/07/05(水) 14:44:33
かきわすれ i = i + 1 はIFブロックの中に入れて、書き込みしたときだけ行が進むようにした方がいいと思います （´・ω・`） 2023/07/05(水) 14:46:11
外付けだからダメなのかな〜とは思いました。 ネットワーク上NGはあり得そうなので、リモートデスクトップ接続が原因？とも思いましたが Dドライブ直下だとうまくいったので…
i=i+1については確かにその通りですね（というかそのせいで空白行ができていたわけですね） 重ね重ねありがとうございます。 （やわら） 2023/07/05(水) 15:55:12
もし、見ているようでしたら、さんと被る部分がありますがご容赦を。
■１
Excelの場合、各オブジェクトの関係性は↓のような構造になっています。
Application（Excel） └Workbookオブジェクト（（開いている）ブック） └WorkSheetオブジェクト（ワークシート） └Rangeオブジェクト（セル）
したがって、【セル】を示すには上記の構造どおりに【どのブック】の【どのシート】の【どのセル】というように示す必要があります。
他方で↓をちょっと真面目に書くと
Set wb_moto = ThisWorkbook Set ws_moto = ActiveSheet
↓のようになります。
Set wb_moto = ThisWorkbook Set ws_moto = ActiveWorkbook.ActiveSheet
これを↓に当てはめて展開してみるとわかると思いますが
wb_moto.ws_moto.Range(〜)
↓のように解釈されている
ThisWorkbook.ActiveWorkbook.ActiveSheet.Range(〜)
~~~~~↑~~~~~ ~~~~~↑~~~~~~~
ブック ブック
【ブックのブック】というようにブックを2重に指定してしまっていたために、そんな構造のものは無いってエラーが出てたわけです。
ThisWorkbook.Worksheets("hoge").Range("A1")
Workbooks("hoge.xlsx").Worksheets(1).Cells(1,1)
なので↑のように、関係性をまちがっていなければ問題ないので【○○名を直書きで指定】とか【Setすればよい】とかそういう話ではありません。
■２
ws.Range("A1:B1").Copy
ws_moto.Range("G" & i & ":H" & i).PasteSpecial
↑のように表現されていますが、PasteSpecialメソッドは左上のセルのみ指定すれば、コピーした範囲に合わせて拡張してくれますから↓のような表現でもＯＫです
ws.Range("A1:B1").Copy
ws_moto.Range("G" & i).PasteSpecial
さらに言うと、Cellsプロパティを使って↓のように表現しても同じ意味になります。
ws_moto.Cells(i,"G").PasteSpecial
■３
wb.Close SaveChanges:=True
関連して↑の処理をしていますが、そうなると↓もマストな処理ということでしょうか？
ws.Range("A1").Value = "=MIN(B2:DQ81)"
ws.Range("B1").Value = "=MAX(B2:DQ81)"
値貼り付けのためだけに書き込んで計算させているだけであれば、直接コード上で計算させてもよいかなと思います。
※なお、問題があるわけではありませんが数式を書き込むなら「Valueプロパティ」ではなく 「Formula」プロパティのほうが本筋かなという感想です。（好みの問題でしょうが）
■４
こちらも好みの問題ですが、「If〜ElseIf〜Else〜 End If」の部分について、今回のようなケースでは「Select Case」で分岐させるというのも有効だとおもいます。
■５
また、なんとかなっているかもしれませんが↓のようにループの中で変数の宣言をするのはお勧めできません。
冒頭で宣言するか、ループの直前（外側）で宣言するようにするとよいと思います。
For Each f In fso.GetFolder(mydir).Files
Dim wb As Workbook
Dim ws As Worksheet
Next f
■６
ということを踏まえて以下のようなアプローチもあったかと思います。
※１ 完成品のプレゼントを意図したものでありません。興味があればステップ実行して研究の上、 必要な部分のみご自身のコードに組み込んでください。
※２ 「■３」でも述べましたが、データ元になるシートに数式を書き込む必要がなければ、 まとめシート？に書き込むだけの話かと思いますのでそちらの例として提示します。
Sub 研究用()
Dim MyFile As Object
Dim dstSH As Worksheet
Dim wb As Workbook, ws As Worksheet
Dim 出力行 As Long
Dim 列 As String
Dim フラグ As Boolean
Stop 'ブレークポイントの代わり
Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set dstSH = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
dstSH.Name = Format(Now, "MMDD_hhmm")
出力行 = 3
For Each MyFile In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files
If MyFile.Type = "Microsoft Excel ワークシート" Then
フラグ = False
Set wb = Workbooks.Open(Filename:=MyFile.Path, ReadOnly:=False)
For Each ws In wb.Worksheets
dstSH.Cells(出力行, "A").Value = wb.Name
If ws.Name Like "*基準値" Then
フラグ = True
Select Case True
Case ws.Name Like "*A*": 列 = "G"
Case ws.Name Like "*B*": 列 = "I"
Case ws.Name Like "*C*": 列 = "K"
Case Else: 列 = "M"
End Select
dstSH.Cells(出力行, 列).Offset(, 0).Value = WorksheetFunction.Min(ws.Range("B2:DQ81"))
dstSH.Cells(出力行, 列).Offset(, 1).Value = WorksheetFunction.Max(ws.Range("B2:DQ81"))
End If
Next ws
If フラグ = False Then
dstSH.Cells(出力行, "A").Value = "【該当なし】" & dstSH.Cells(出力行, "A").Value
End If
wb.Close False
出力行 = 出力行 + 1
End If
Next MyFile
End Sub
（もこな２） 2023/07/18(火) 07:55:44
＞値貼り付けのためだけに書き込んで計算させているだけであれば〜
ここは特に仕様があるわけではなく、直接書き込むか悩んだのですが
他の人の作業のお手伝いだったので作業の痕跡を残しておいたほうが疑われないかなと思ってこうしました。
（やわら） 2023/07/25(火) 11:25:36
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.