[[20111031111438]]　『各シートの任意の列の一番下にSUBTOTAL関数をマク』（龍）　ページの最後に飛ぶ

『各シートの任意の列の一番下にSUBTOTAL関数をマクロで入力』（龍）

 各シートのＵ列の2行目から始まる注文残（下の行は一定でない）を積算するために、「値のある最後のセルの一つ下のセル」にサブトータル関数を入力したいのですが、別サイトで見つけたコード{下記}を入れても上手くいきません。

 どなたか下記で上手くいかない理由を教えていただければありがたいです。
 宜しくお願いします。

Sub マクロ入力()

  Dim objSheet As Object
  For Each objSheet In ActiveWorkbook.Worksheets
    objSheet.Activate
   With Range("U2")
        .End(xlDown).Offset(1, 0) = _
            "=SUBTOTAL(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
    End With
Next
End Sub

 ※.End(xlDown).Offset(1, 0) = _
            "=SUBTOTAL(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
この部分に実行時エラー1004が出ます。

 本当にそんなコードだったの？

 SUBTOTALの構文にあってないよ。

 SUBTOTALの構文は
 =SUBTOTAL(集計方法,範囲 1,範囲 2,...)
 だけど集計方法が指定されてないよ。
 (春日野馨)

 かぶったけど、メモったので。

 .End(xlDown).Offset(1, 0) = は　.End(xlDown).Offset(1, 0).Formula = のほうがわかりやすくていいだろうけど、さておき。

 1004は、「エクセルとしてはなんだかわからない（理解ができない）指定がされたぞ！」というエラー。
このセルに入れようとした計算式 "=SUBTOTAL(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
が、正しいイメージなのかどうか？

 このコードの前に
MsgBox "=SUBTOTAL(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
これをいれて、もう一度実行してみよう。表示されるSUBTOTAL式は、正しい式かな？

 (ぶらっと)

 プラット様
 ありがとうございます。
 ご指示いただいたメッセージボックスは、「SUBTOTAL（Ｕ2:Ｕ7456）」と出ました。
 初心者なので、何もわかっていないのですが、やりたいことは、複数のシートについて、下記を設定したいのです。
 U列にあるソートされた数字の積算を求めたいので、各シートの最後の値の１つ下のセルにSUBTOTAL関数を
 自動入力する。各シートともにU2から数字が開始しますが、最後のセルは各シートで一定ではありません。　
 ご教授をお願い致します。
（龍）

 既に、(春日野馨)さんから回答がでてるけど？
=SUBTOTAL(U2:U7456) と、どこかのセルに（手入力で）入れてみると、どうなる？
で、ヘルプなり参考書で、SUBTOTAL関数を調べてみよう。

 ちなみに、私は「プラット」ではありません。「ぶらっと」です。
プラットフォームの「プ」じゃなく、ぶらじるの「ぶ」。

 (ぶらっと)

 あと、その表はオートフィルタをかけるか、表の途中にSUBTOTALで小計を入れたりしてるの？
 そういうのが無いんだったらSUBTOTALじゃなくSUMでも十分だと思うけども。
 (春日野馨)

ぶらっと様

 大変失礼いたしました。
 　
 春日野馨様
 ありがとうございます。
 表は、オートフィルタをかけて積算しますので、
 SUBTOTAL関数にしたいのです。

 教えていただき、下記のようにしたところ一部のシートでは、
上手くいきました。

 しかし、シートによっては、Ｕ１の表題しかないシートもあり、「（Ｕ２）から空白」で
 エラーになってしまいます。
　U2に値がないときは、U2のセルにに「注残0」というような表示を出したいのですが、
 どのようにコードを書けばよいですか？
 超初心者につき、ご教授いただければ幸甚です。

 Sub マクロ()
  Dim objSheet As Object
  For Each objSheet In ActiveWorkbook.Worksheets
    objSheet.Activate
   With Range("U2")
　.End(xlDown).Offset(1, 0).Formula =
            "=SUBTOTAL(9," & Range(.Address, .End(xlDown)).Address(False, False) & ")"
    End With
  Next
End Sub

（龍）

追記：上記で再度マクロを実行したら、「コンパイルエラー：

 参照が不正または不完全です」となってしまいました。(龍)

 これでどうかな？
 U2が空白の時、U2にしか値が無い(U3以下が空白)の時にも対応してるよ。
 (春日野馨)

 Sub マクロ()
    Dim objSheet As Worksheet

    For Each objSheet In ActiveWorkbook.Worksheets
        With objSheet.Range("U2")
            If .Value = "" Then
                .Value = "注残0"
            Else
                .Offset(-1, 0).End(xlDown).Offset(1, 0).Formula = "=SUBTOTAL(9," & objSheet.Range(.Address, .Offset(-1, 0).End(xlDown)).Address(False, False) & ")"
            End If
        End With
    Next
 End Sub

春日野馨様

 ありがとうございます。
 折角、書いていただいたコードですが、ダメでした。
 下記のようなコードを自分でも考えましたが、ダメでした。
 機能しない理由が分かりません。
 少しやりたいことをシンプルにしたと思うのですが・・・

Sub マクロ()

     Dim objSheet As Worksheet
    For Each objSheet In ActiveWorkbook.Worksheets
   With objSheet.Range("U2").End(xlDown).Offset(1, 0).Formula = "= SUBTOTAL(9,U2:U10000)"
           End With
    Next
 End Sub

 やりたいことは、「ｕ行の値のある最終行の一つ下のセルにu2からu10000までを選択し、subtotal関数」です。
これなら、u2に値がなくても、u2に0になって問題ないと考えました。
 如何でしょうか？

 春日野馨さんのなら出来そうですけど試しました？

 龍さんのですとU2に値が無い場合、U65536(2003までの場合）が最終行に該当しますよ？
 なので、そのOffset(1，0)なんてありえないセルですからエラーになります。

 msgbox objSheet.Range("U2").End(xlDown).row

 とでもして確認されては？

 ちなみにSUBTOTALの第１引数は109じゃなくて良いのかな？
 （ｍｏｍｏ）

 SUBTOTAL関数の引数についてはｍｏｍｏさん五指摘の通り。
[春日野馨]さんので動きそうですが、なぜでしょうね。
私のExcel2003でもちゃんと結果が出ているみたいです。
　
「ダメでした」では画面を見ていない人には詳細が伝わらないので、
どういう結果になったからダメだった、ということを書き込んでください。
先の「コンパイルエラー」みたいに。
　
（まさか、U列がスペースで最終行まで埋まっているシートがある、
とか、実は歯抜けデータというオチじゃあるまいね？）
　
U列が全部データで埋まっているということがなければ次のようでも
良いと思うのだけれども。
 Sub マクロ()
    Dim objSheet As Worksheet
    For Each objSheet In ActiveWorkbook.Worksheets
        With objSheet.Cells(Rows.Count, 21).End(xlUp)
            If .Row = 1 Then
                .Offset(1, 0).Value = "注残0"
            Else
                .Offset(1, 0).Formula = "=SUBTOTAL(109,u2:" & .Address(False, False) & ")"
            End If
        End With
    Next
 End Sub
　
(みやほりん)(-_∂)b

皆さま
ご教授ありがとうございます。

 返信が遅くなり、申し訳ありません。
 (みやほりん)様のコードでやってみました。
 エラーにはなりませんが、50あるシートのうち、
 約半数弱に式が入力され、その他は入力されませんでした。
 春日野馨様のコードで再度行ったときに、アプリケーション定義またはオブジェクト定義のエラーと
 出ました。
 (みやほりん)様のコードで エラーにはならないのに、必ずしも最終行に入力されない理由が分かりません。
 U列がスペースで最終行まで埋まっているシートはありません
 歯抜けデータとは何ですか？
  その他にはどういったことが考えられるでしょうか？
 (龍)

 ＞その他は入力されませんでした。
ほんとに？
私のコードはそのブックの全てのシートのU列に対して、
   .Offset(1, 0).Value = "注残0"
か、
   .Offset(1, 0).Formula = "=SUBTOTAL(109,u2:" & .Address(False, False) & ")"
のどちらかが必ず実行されます。
　
エラーも発生せず、かつ、なにも書き込まれないということ自体がありえません。
龍さんが「最終行」と思っている行のさらに下に数式がすでに入力されていると
推測します。（つまり、何もない、と見えて何か入力されているセルが下にたくさんある）
U列でCtrlを押しながら↓キーを何回か押してみてください。
入力された数式があるはずですし、シートの下端行までに３回以上ストップするようなら
それが歯抜けデータです。　
(みやほりん)(-_∂)b

 実は空白だと思っているセルには無くて
 ず～っと下の方にあった。なんて事はないですか？

 だとしたら、数式で""にしているか長さ0の文字列が残ってると思うので

  Sub マクロ()
    Dim objSheet As Worksheet
    Dim myRng    As Range
    For Each objSheet In ActiveWorkbook.Worksheets
      With objSheet.Columns("U")
        Set myRng = .Find("*", .Cells(1), xlValues, xlPart, xlByRows, xlPrevious)
        If myRng.Row = 1 Then
          myRng.Offset(1, 0).Value = "注残0"
        Else
          myRng.Offset(1, 0).Formula = "=SUBTOTAL(109,U2:" & myRng.Address(False, False) & ")"
        End If
      End With
    Next
  End Sub

 こんな風にしないと出来ないかもしれませんね。
 （ｍｏｍｏ）

皆さま　ありがとうございます。
ｍｏｍｏ様のコードでやってみたけどダメでした。((みやほりん)さんと同じ結果になりました。
)

 ※シート1の範囲a1:ab10000をコピーし、シート50枚にその内容を貼り付けた後、
 シートの名前を各シートのＭ1に映しこみ、各シートについてＭ1にある客先以外の行を
 全て削除するマクロで顧客の注残管理をしようとしています。

 この辺の設定で問題があるかもしれませんが、基本的にはこのコード以外は完成しているので、
 いじりたくありません。
　{龍}

 私の最後のコードでも出来ないのであれば、根本的に変ですね。
 みやほりんさんのコードと同じく必ずなにか記入されます。
 ダメというのは、何を見て判断していますか？
 U10000まで見たうえで何も無いですか？
 みやほりんさんのと違うのは、見た目が空白に見えていても最終行を取得する事です。

 以下を確認してください。

 シート１はどんな内容ですか？　数式ですか？　どこかからのコピペですか？
 コピーはどのようにやっていますか？　値のみですか？
 そのコードは掲示できますか？
 Ｍ１以外の行削除はどのようにやっていますか？
 オートフィルタなどは設定していますか？　どの範囲を対象としていますか？

 （ｍｏｍｏ）

たしかにオートフィルタで抽出している状態だと変な場所に数式が入りますね。

みやほりん

シート1は、元々CSVファイルです。

 様々な客先の入った受注出荷一覧表です。
 a1からag10000まであります。
 数式はありません、値のみです。

 コピーコードは、下記のとおりです。
Sub マクロAD()
 Dim i As Long
    For i = 3 To Worksheets.Count
       Sheets(1).Range("A1:AG10000").Copy Sheets(i).Range("A1")
       Next
    End Sub

Sub マクロAE()

    Dim i As Long
    For i = 3 To Worksheets.Count
        With Worksheets(i).Range("M1")
            .Value = Worksheets(i).Name
            .Font.Bold = True
            .Font.Italic = True
        End With
    Next
  End Sub

Sub マクロAF()

 Dim i As Long
    For i = 3 To Worksheets.Count
        With Worksheets(i).Columns("M")
            .ColumnDifferences(.Cells(1)).EntireRow.Delete
        End With
  Next
End Sub

 オートフィルタは、下記のとおりです。
Sub マクロAG()
  Dim objSheet As Object
  For Each objSheet In ActiveWorkbook.Worksheets
    objSheet.Activate
Range("D2").Select
    ActiveWindow.FreezePanes = True
Range("A1:AG1").Select
    Selection.AutoFilter
Range("$A$1:$AG$10000").AutoFilter Field:=21, Criteria1:="<>0", _
        Operator:=xlAnd
Next
End Sub

です。

 ご確認をお願いします。{龍}

 やっぱりオートフィルターが原因ですね。
 こういう情報は早い段階で出して頂く方が解決も早いです。

 最終行のＵ列が0の場合に非表示になるために
 実際のデータの非表示行の最終エリアに数式を設定してしまっています。
 該当したシートのＵ列最終行が0だったんだと思いますよ。

 以下のように変更してみましょう

  Sub マクロ()
    Dim objSheet As Worksheet
    Dim myRng    As Range
    For Each objSheet In ActiveWorkbook.Worksheets
      With objSheet.Columns("U").SpecialCells(xlCellTypeVisible)
        Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
        If myRng.Row = 2 Then
          myRng.Value = "注残0"
        Else
          myRng.Formula = "=SUBTOTAL(109,U2:" & myRng.Offset(-1).Address(False, False) & ")"
        End If
      End With
    Next
  End Sub

 （ｍｏｍｏ）

momo様　本当にありがとうございます！

 無事に出来ました。感激です。（2日間悩みまくりましたので・・・）
 お手数ですが、もう一つ質問させてください。 
 返した値について全て①セルの中心に位置させる、②100の位に’をつける、
 ③太字にする事を追加したいのですが、下記のようにやっても反応がありません。
 初心者でどこにどうコードを書くか分かりません。
 教えていただければ幸甚です。

   Sub マクロAH()
   Dim objSheet As Worksheet
    Dim myRng    As Range
    For Each objSheet In ActiveWorkbook.Worksheets
      With objSheet.Columns("U").SpecialCells(xlCellTypeVisible)
        Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
        If myRng.Row = 2 Then
          myRng.Value = "注残0"
HorizontalAlignment = xlCenter
Style = "Comma [0]"
Font.Bold = True

        Else
          myRng.Formula = "=SUBTOTAL(109,U2:" & myRng.Offset(-1).Address(False, False) & ")"
HorizontalAlignment = xlCenter
Style = "Comma [0]"
Font.Bold = True

        End If
      End With
    Next
  End Sub

{龍}

 試してませんが・・・

   Sub マクロAH()
   Dim objSheet As Worksheet
    Dim myRng    As Range
    For Each objSheet In ActiveWorkbook.Worksheets
      With objSheet.Columns("U").SpecialCells(xlCellTypeVisible)
        Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
        If myRng.Row = 2 Then
          myRng.Value = "注残0"
        Else
          myRng.Formula = "=SUBTOTAL(109,U2:" & myRng.Offset(-1).Address(False, False) & ")"
        End If
      End With
      With myRng
        .HorizontalAlignment = xlCenter
        .Style = "Comma [0]"
        .Font.Bold = True
      End With
    Next
  End Sub

 （ｍｏｍｏ）

ｍｏｍｏ様

 感激です。
 本当にありがとうございます。
 3日間、自分でもいただいたコードを切ったり貼ったりしましたが、
 どうにもなりませんでした。
 いただいたコードを分析して、レベルアップしたいと思います。

（龍）

 実は新しい問題が発生して困っております。
 U列のマクロは、上記ｍｏｍｏ様から頂いたコードで完璧に出来ました。
 もうひとつの列「AE」についても同じマクロを組んでみましたが、
 AE列については、項目内容が[最新出荷実績]であり、
 各行に数字があったりなかったり一定ではありません。
 そこで、U列にマクロでSUBTOTAL関数を入力する行と同じ行のAE列に、
 AE2からAE（U列の最終行）を積算するSUBTOTAL関数を
 作れますでしょうか？
 ご教授をお願いします。
（龍）

 変数myRngがU列最終行の次のセルですから
 AE列なら右に10列オフセットすれば、その行のAE列になります。
 myRng.Offset(0, 10)
 （ｍｏｍｏ）

ｍｏｍｏ様

 ありがとうございます。 
 ご教授いただき、下記コードを実行しましたが、
 循環して進まなくなったので、中断しました。 
　下記では、問題があるのでしょうか
 お手数ですが、ご確認をお願いします。

 Sub マクロ()
   Dim objSheet As Worksheet
    Dim myRng    As Range
    For Each objSheet In ActiveWorkbook.Worksheets
        If objSheet.Name <> "SHEET3" Then
            With objSheet.Columns("AE").SpecialCells(xlCellTypeVisible)
                Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
                If myRng.Row = 2 Then
                    myRng.Value = "注残0"
                Else
                    myRng.Formula = "=SUBTOTAL(109,AE2:" & myRng.Offset(0, 10).Address(False, False) & ")"

                End If
            End With
            With myRng
                .HorizontalAlignment = xlCenter
                .Style = "Comma [0]"
                .Font.Bold = True
            End With
        End If
    Next
 End Sub

 >With objSheet.Columns("AE").SpecialCells(xlCellTypeVisible)
 ここをＡＥ列にしてしまったら
 >Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
 ここで取得する最終行の次の行はＵ列とは違ってしまいますよ？
 それに
 >myRng.Formula = "=SUBTOTAL(109,AE2:" & myRng.Offset(0, 10).Address(False, False) & ")"
 ＡＥ列からオフセット10列してしまったらＡＥ列ではないですよね？

   Sub マクロAH()
   Dim objSheet As Worksheet
    Dim myRng    As Range
    For Each objSheet In ActiveWorkbook.Worksheets
      With objSheet.Columns("U").SpecialCells(xlCellTypeVisible)
        Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
        Set myRng = objSheet.Range(myRng.Address & "," & myRng.Offset(, 10).Address)
      End With
      If myRng.Row = 2 Then
        myRng.Value = "注残0"
      Else
        myRng.FormulaR1C1 = "=SUBTOTAL(109,R2C:R" & myRng.Offset(-1).Row & "C)"
      End If
      With myRng
        .HorizontalAlignment = xlCenter
        .Style = "Comma [0]"
        .Font.Bold = True
      End With
    Next
  End Sub

 （ｍｏｍｏ）

ｍｏｍｏ様

 何度もすみません。
 いただいたコードで実行してみたところ、
 U列用のマクロで入力されたSUBTOTAL関数の一つ下のセルに
 おそらく上記いただいたマクロで入力されたSUBTOTAL関数が
 入力されました。

 また、AE列は、U列用のマクロで入力されたSUBTOTAL関数の一つ下のセルに
 SUBTOTAL関数が入力されました。

 残したい結果は、U列については一つ下のセルを入力させず、
 AE列は現在入力されている関数のセルの位置を一つ上げることです。
 本当に何度も申し訳ございませんが、ご教授いただければ幸甚です。
 (仕組みが分からないので応用が出来ず、申し訳ございません)

 ｛龍｝

 Ｕ列用とＡＥ列用と別のプロシージャにするのですか？
 私が掲示したコードは、１つのプロシージャでＵ列とＡＥ列の両方を処理するものですよ？
 まったく同じ処理をするのに別のプロシージャに分ける理由はなんですか？
 （ｍｏｍｏ）

ｍｏｍｏ様

 ご指摘を受けて、一つのプロシージャにまとめてみましたが、
 分けている時と同じ結果になりました。
 それと、このマクロは、かなり時間がかかりますが、
 下記のようなまとめ方で良いのでしょうか
 何度も申し訳ございませんが、ご教授をお願いします。（龍）

  Sub マクロAI()
 Dim objSheet As Worksheet
    Dim myRng    As Range
        For Each objSheet In ActiveWorkbook.Worksheets
        If objSheet.Name <> "最新出荷記録" Then
            With objSheet.Columns("U").SpecialCells(xlCellTypeVisible)
                Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
                If myRng.Row = 2 Then
                    myRng.Value = "注残0"
                Else
                    myRng.Formula = "=SUBTOTAL(109,U2:" & myRng.Offset(-1).Address(False, False) & ")"
                End If
            End With
            With myRng
                .HorizontalAlignment = xlCenter
                .Style = "Comma [0]"
                .Font.Bold = True
            End With
        End If
    Next

     For Each objSheet In ActiveWorkbook.Worksheets
      With objSheet.Columns("U").SpecialCells(xlCellTypeVisible)
        Set myRng = .Find("", .Cells(1), xlValues, xlPart, xlByRows, xlNext)
        Set myRng = objSheet.Range(myRng.Address & "," & myRng.Offset(, 10).Address)
      End With
      If myRng.Row = 2 Then
        myRng.Value = "注残0"
      Else
        myRng.FormulaR1C1 = "=SUBTOTAL(109,R2C:R" & myRng.Offset(-1).Row & "C)"
      End If
      With myRng
        .HorizontalAlignment = xlCenter
        .Style = "Comma [0]"
        .Font.Bold = True
      End With
    Next

 End Sub

 いえいえ、私の掲示したコードだけでＵ列とＡＥ列が処理できているはずです。
 という事です。

 元々のＵ列だけのコードは必要ありません。
 （ｍｏｍｏ）

ｍｏｍｏ様

 お陰さまで上手くいきました。
  度重なるご教授本当にありがとうございました。
 （龍）

コメント返信：

[ 一覧(最新更新順) ]

[[20111031111438]] 『各シートの任意の列の一番下にSUBTOTAL関数をマク』（龍） ページの最後に飛ぶ

[[20111031111438]]　『各シートの任意の列の一番下にSUBTOTAL関数をマク』（龍）　ページの最後に飛ぶ