串刺し計算のシート選択を曖昧な条件で指定できませんでしょうか？

同じ配列のシートが日別で並んでいますがシートが日ごとに追加されますので何か良い指定方法はありませんでしょうか。
現在の記述は下記のとおりで都度シート名を指定しなければなりません。

Sub kusizashi()

Worksheets("累計").Range("B3").Consolidate Sources:= _
Array("時間別項目別20210301!R3C2:R11C8", "時間別項目別20210302!R3C2:R11C8"), Function:=xlSum

End Sub


ご教示いただければ幸いです。

質問者からの補足コメント

• お考えいただきありがとうございます。
  月次単位のBookでセル範囲の同じシートが毎月1日からの平日で追加されていきます。
  シート名が「時間別項目別＋日付」となっていますので、日付の部分を曖昧でも範囲指定できるようなことができないか考えていました。
  よろしくお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2021/03/09 09:29

• お考えいただきありがとうございます。
  月次単位のBookでセル範囲の同じシートが毎月1日からの平日分追加されていきます。
  シート名が「時間別項目別＋日付」となっていますので、日付の部分を曖昧でも範囲指定できるようなことができないか考えていました。
  集計シートは当初左にありましたが、短日のデータ「Sheet1」をコピーして右へ名前を付けて（時間別項目別＋日付）保存の際、おかしな動きになってしまい右へ移動しました。確かに月末にはだいぶ右になりますが今のところ、おかしな動きの改善策が見当たらずやむなしとしています。
  よろしくお願いいたします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/03/09 09:38

• 予め、まだ発生していない日付のシート名（時間別項目別20210308!R3C2:R11C15）を指定しておけば！と下記の記述をしてみましたが「統合元ファイル時間別項目別20210308を開くことができません」とメッセージが出ます。
  
  Array("時間別項目別20210301!R3C2:R11C15", "時間別項目別20210302!R3C2:R11C15", "時間別項目別20210303!R3C2:R11C15", "時間別項目別20210304!R3C2:R11C15", "時間別項目別20210305!R3C2:R11C15", "時間別項目別20210308!R3C2:R11C15"), Function:=xlSum
  
  このメッセージが出ないようにすることは可能でしょうか？

    補足日時：2021/03/09 11:05

• goo maniaさんの記述でシート名「累計」‘意外のシート名だったらとありますが、省きたいシートが他に「sheet1」「時間別項目別一覧表」の3シートあります。
  if文をどのように記載したら省けるかご教示いただけませんでしょうか。
  よろしくお願いいたします。

    補足日時：2021/03/09 15:47

• 最初の記述ですと上手く行くのですが、追加でご教示いただいたif文に修正するとNext以下でエラーが出てしまいました？お手数ですが修正点をご教示いただけると助かります。
  
  If (Worksheets(i).Name <> "累計") And(Worksheets(i).Name <> "Sheet1") And (Worksheets(i).Name <> “時間別項目別一覧”) Then
  n = n + 1
  wsn(n) = Worksheets(i).Name & "!R3C2:R11C8"
  End If
  Next
  Worksheets("累計").Range("B3").Consolidate Sources:= _
  Array(wsn()), Function:=xlSum Array(wsn())をwsnと省略可
  End Sub

    補足日時：2021/03/09 17:21

No.8 ベストアンサー 回答者： めぐみん_ 回答日時： 2021/03/09 18:01

日付から該当シートを求めるコード。

ただし実行日のデータを含めるのか否かが重要なキーになりますね。
コメント文にしているので、適宜どちらか一方を選んでください。

Sub megu_2()
Dim ws As Worksheet
Dim sumst As String, v()
Dim i As Integer

sumst = "!R3C2:R11C15"

i = 0

For Each ws In Worksheets

If ws.Name Like "時間別項目別*" Then

'If Replace(ws.Name, "時間別項目別", "") <= Format(Date, "yyyymmdd") Then '今日までの日付
If Replace(ws.Name, "時間別項目別", "") < Format(Date, "yyyymmdd") Then '前日までの日付

ReDim Preserve v(i)

v(i) = ws.Name & sumst
i = i + 1

End If
End If

Next

Worksheets("累計").Range("B3").Consolidate Sources:=v, Function:=xlSum

End Sub

抜けている日付は無視しますので。（シートが存在しないのでしょうし）

この回答へのお礼

当初イメージでご教授いただきありがとうございます。助かりました。

お礼日時：2021/03/09 18:29

No.7 回答者： goomania 回答日時： 2021/03/09 17:51

No.6です。

>Next以下でエラーが出てしまいました。
エラー内容を教えてほしいのですが、ここでエラーとなるのは配列の内容に問題があると推測されます。

ReDim wsn(1 To sc - 3)

への修正は実施しましたか?

また、投稿されたコードがコピペだとすると

Worksheets("累計").Range("B3").Consolidate Sources:= _
Array(wsn()), Function:=xlSum Array(wsn())をwsnと省略可

「Array(wsn())をwsnと省略可」の前に「'」が無いのが気になります。

この回答へのお礼

3に変更てしいませんでした。
ありがとうございました。

お礼日時：2021/03/09 18:28

No.6 回答者： goomania 回答日時： 2021/03/09 16:42

単純にAndで繋ぐだけです。

さらに増えた場合もAndで繋いでいけばOKです。

If (Worksheets(i).Name <> "累計") And (Worksheets(i).Name <> "Sheet1") And (Worksheets(i).Name <> "時間別項目別一覧表") Then

※「sheet1」なのか「Sheet1」なのが大文字・小文字に注意。実際のシート名に合わせること

さらに、ReDim wsn(1 To sc - 1)を

ReDim wsn(1 To sc - 3)

に修正します。
ここでは、配列の大きさを定義していますが、存在するシート数から集計で省くシート数をマイナスしています。従って-1ではなく-3にするということです。

No.5 回答者： goomania 回答日時： 2021/03/09 15:03

No.3さんの回答で解決済みかもしれませんが、

>集計シートは当初左にありましたが、短日のデータ「Sheet1」をコピーし
>て右へ名前を付けて（時間別項目別＋日付）保存の際、おかしな動きになっ
>てしまい右へ移動しました。

ということなので、累計シートの位置にかかわらず、集計できるよう配慮しました。実行速度はNo.3さんのFor each文を使用した方が速いと思います。

Sub kusizashi()
Dim sc As Integer
Dim i As Integer
Dim n As Integer
Dim wsn() As Variant 'ワークシート・セル範囲を格納する動的配列を指定
sc = Worksheets.Count
ReDim wsn(1 To sc - 1) '配列を再定義
n = 0
For i = 1 To sc
If Worksheets(i).Name <> "累計" Then 'シート名「累計」以外のシート名だったら
n = n + 1
wsn(n) = Worksheets(i).Name & "!R3C2:R11C8" 'シート名と集計セル範囲を配列に格納
End If
Next
Worksheets("累計").Range("B3").Consolidate Sources:= _
Array(wsn()), Function:=xlSum '格納された配列に基づき各シート範囲を累計シートに集計　Array(wsn())をwsnと省略可
End Sub

No.4 回答者： めぐみん_ 回答日時： 2021/03/09 13:49

＞このメッセージが出ないようにすることは可能でしょうか？

エラーが出たら『なかった事にする（無視）』のは可能でしょうけど、必要な結果(~3/5)も得られず手段としてはどうかな？と感じます。

この回答へのお礼

やはり乱暴ですよね
ありがとうございました。

お礼日時：2021/03/09 15:22

No.3 回答者： めぐみん_ 回答日時： 2021/03/09 13:27

例えばctrlキーを押しながらマウスでシートタブをクリックするか、連続するなら片端になるしとタブをクリックし次にshiftキーを押しながらもう片端のシートタブをクリックするとその間のシートは選択状態になります。

その状態のままで実行させる方法なら、

Sub megu()
Dim ws As Worksheet
Dim sumst As String, v()
Dim i As Integer

sumst = "!R3C2:R11C15" '

ReDim v(ActiveWindow.SelectedSheets.Count - 1)

i = 0

For Each ws In ActiveWindow.SelectedSheets

v(i) = ws.Name & sumst
i = i + 1

Next

Worksheets("累計").Range("B3").Consolidate Sources:=v, Function:=xlSum

End Sub

これで如何でしょうか？
使い勝手がって言うなら他を検討してみますが。
⇒日付が全てあるならシートインデックスで求めてしまう方法もありそうなのですが平日限定ですよね？シートの存在は。

この回答へのお礼

ありがとうございます。
シートを選択して計算できました。

お礼日時：2021/03/09 15:22

No.2 回答者： めぐみん_ 回答日時： 2021/03/09 08:29

No.1です。

追加される日付と言う考えは置いておいて、追加されたシートのインデックスで選ぶと言う方法もあるかもですが、ようは毎月１日から追加されていったシート分を加算させると言う事でしょうか？
画像では５日のようですが『１日～５日までの串刺し』と言う事ですか？
⇒集計シートが一番右ってのは日にちがたつと扱いにくくないでしょうか？

No.1 回答者： めぐみん_ 回答日時： 2021/03/09 06:38

曖昧検索なのですか？

ある期間のシートを指定したいのなら条件を与え全てのシート名を調べて、該当したシート名を配列に入れていき、それを与えれば良いのでは？

ただ何をもって条件とするのかが不明ですけど
串刺しなのでセル範囲は同じなのですよね？