[[20190623201818]]　『項目ごとの小計を抽出するには』（keiji）　ページの最後に飛ぶ

『項目ごとの小計を抽出するには』（keiji）

見積書の中項目へ小計を吸い上げたのですがご教授お願いします。
以下がフォーマットです。

中項目ページは1ないし2ページを使用しています。

   A     省略         H                 M
1.○○工事                             =H50

2.□□工事 =H220

3.△△工事 =H350

省略
以上中項目ページ説明

中項目終了ページから次のページから本文（内訳明細ページに移る）
1.○○工事
　××　　50 H列に行ごとの合計
　○△　　15　　　同上
省略
↓ここへ1.○○工事に対しての小計

   小計           SUM(H?:H?)

以下2.　3.　続く
この中項目ごとの小計をM列に関数　=H50　のように
上記では　=H50　=H220　=H350　ですが
必ず中項目最終には「小計」を入れています。
可能かどうかわかりませんが可能であれば
説明が伝わるかどうか不安ですが
お知恵拝借したいので、よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

＞『項目ごとの小計を抽出するには』
　　↓
＞小計をM列に関数　=H50　のように

小計の抽出は済んでいるのでは?

＞可能かどうかわかりませんが可能であれば
＞説明が伝わるかどうか・・・・・・

私には理解できません。

（PPM） 2019/06/23(日) 21:25

（PPM）さん
やはり説明不十分理解不能ですか
A列、「小計」の場所（行）は不特定です。
概要
1.○○工事

2.□□工事
省略
必ず内訳明細ページ側の先頭に同じ名前の工事名を書込その下の行から
明細記入　各工事ごとにしまい行に「小計」を入れています。

上記の「小計」のセルを特定して、中項目同じ名前の（A列）工事名（1.○○工事など）の
M列にこの「小計」セルを書き込みたい。これが例として（不特定ですが）=H50とか
=H220とかのように数式で入れる。という作業をマクロでないでしょうか？
※通常は手作業で行っているのですがページ数が30～40になると（2000～3000行目程度）
スクロールが大変なので
よろしくお願いします。

（keiji） 2019/06/24(月) 01:11

 ＞という作業をマクロでないでしょうか？

 １．ちょっと、表現がおかしいです。
 　マクロでやりたい、と言うことですか？
 　それとも、マクロなしでやりたい、と言うことですか？

 ２．「小計」という文字はどの列にあるんですか？
 　　　A列なんですか？

 ＞（A列）工事名（1.○○工事など）

 ３．本当に「1．」なんてのが頭にくっついているんですか？
 　それを正確に励行しているならユニークなキーになって有効ですが、
 　逆にテキトーに付けているなら、探しに行っても「該当なし」になる恐れが増大します。

 ４．内訳明細の先頭位置は、2回目に出てくる「工事名（1.○○工事など）」を探す以外にないですか？
 　　単純な例では、「これより内訳明細」と唯一どこかに書いてあれば簡明です。

 ５．工事名の出現順は、吸い上げ側と、内訳明細側は同じですね？

（半平太） 2019/06/24(月) 08:32

（半平太）さん
解りにくくて申し訳ありません。
＞１．ちょっと、表現がおかしいです。
＞　マクロでやりたい、と言うことですか？
マクロでお願いします。

＞２．「小計」という文字はどの列にあるんですか？
＞　　　A列なんですか？
Ａ列です
内訳明細の各工事項目の（1.○○工事など）最終行（ページの変わる1行手前にあります）

     A    ・・・                                           H
1.○○工事
　××××シート？枚（Ｂ.Ｃ.Ｄ.Ｅ.Ｆ.Ｇは仕様単価など）     1,100
  以下内訳が続き

　小計 55,000
55,000は、1,100から小計１行上までのSUM()で入力しています。

＞３．本当に「1．」なんてのが頭にくっついているんですか？
＞　それを正確に励行しているならユニークなキーになって有効ですが、
＞　逆にテキトーに付けているなら、探しに行っても「該当なし」になる恐れが増大します。
はい、ついています。正確には
全体グループ名
Ａ．×××工事
1.○○工事
2.△△工事
　1）○△工事
　2）×◎工事
3.□◎工事

Ｂ．×◎△工事
1.□○工事
2.□×工事
Ａの2.の場合はその中でまた分ける必要が出た場合の記述です。
こんな構成です。これを内訳明細側のそのページの最上段に記述してから
以下各明細を１つ１つ書き込んでいます。

＞４．内訳明細の先頭位置は、2回目に出てくる「工事名（1.○○工事など）」を探す以外＞にないですか？
＞　　単純な例では、「これより内訳明細」と唯一どこかに書いてあれば簡明です。
これについては中項目が１ページで済むか２ページなのかで境目がありますので
フォーマットを見ると境目のページがかわる手前に(１行ないし２行目)諸経費項目が
必ずあります。中項目の流れで　Ｃ．諸経費　なのか　Ｄ．諸経費なのかはまちまちですが
「諸経費」が最終でページが切り替わり内訳明細へ移行します。

＞５．工事名の出現順は、吸い上げ側と、内訳明細側は同じですね？
出現順はおなじです。
最初に中項目を作成し、順を追い作成していきます。
ややこしくてすみません、が
よろしくお願いします
（keiji） 2019/06/24(月) 13:56

説明ずれました

     A    ・・・                                           H
1.○○工事
　××××シート？枚（Ｂ.Ｃ.Ｄ.Ｅ.Ｆ.Ｇは仕様単価など）     1,100
  以下内訳が続き

　小計　　　　　　　　　　　　　　　　　　　　　　　　　　55,000
55,000は、1,100から小計１行上までのSUM()で入力しています。
（keiji） 2019/06/24(月) 14:00

 データの在り様が、こちらが思っている通りであるかチェックしたいので、
 下記コードを「見積書」のシートモジュールに貼り付けて、実行してみてください。

 実行後、下記メッセージが表示されるかどうか確認してください。
  ”データの在り様は想定通りです”

 ’-------「見積書」のシートモジュールに貼り付けるマクロ　(注意：標準モジュールではない）----
 Sub triral()
     Dim rToProc As Range
     Dim fItem As Range
     Dim fDetail As Range
     Dim cel As Range

     Set rToProc = Range("A1", Cells(Rows.Count, "A").End(xlUp))
     Set fItem = Columns(1).SpecialCells(xlCellTypeConstants, 23).Cells(1, 1)
     Set fDetail = rToProc.Offset(fItem.Row).Find(What:=fItem.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

     For Each cel In Range(fItem, fDetail.Offset(-1)).SpecialCells(xlCellTypeConstants, 23)
         If Application.CountIf(Columns("A"), cel) <> 2 Then
             MsgBox fItem.Value & "がA列に2個未満、または2個超になっています。"
             Exit Sub
         End If
     Next
     MsgBox "データの在り様は想定通りです"
 End Sub

 もし上記メッセージとは違った場合、いままでの説明で十分だったかどうか検討してください。
 こちらに勘違いがあるかも知れない場合は、その旨ご指摘ください。

（半平太） 2019/06/24(月) 15:17

（半平太）さん
ありがとうございます。
実行してみましたがエラーが出てしまいます
★＝「オブジェクト変数またはwithブロック変数が設定されていません。」
Sub triral()

     Dim rToProc As Range
     Dim fItem As Range
     Dim fDetail As Range
     Dim cel As Range

     Set rToProc = Range("A1", Cells(Rows.Count, "A").End(xlUp))
     Set fItem = Columns(1).SpecialCells(xlCellTypeConstants, 23).Cells(1, 1)’★
     Set fDetail = rToProc.Offset(fItem.Row).Find(What:=fItem.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

     For Each cel In Range(fItem, fDetail.Offset(-1)).SpecialCells(xlCellTypeConstants, 23)
         If Application.CountIf(Columns("A"), cel) <> 2 Then
             MsgBox fItem.Value & "がA列に2個未満、または2個超になっています。"
             Exit Sub
         End If
     Next
     MsgBox "データの在り様は想定通りです"
 End Sub

（keiji） 2019/06/24(月) 15:51

Excel再起動後テストしてみた結果
エラーの場所変わりました
実行時エラー91
「オブジェクト変数またはwithブロック変数が設定されていません。」
となりました。
Sub triral()

     Dim rToProc As Range
     Dim fItem As Range
     Dim fDetail As Range
     Dim cel As Range

     Set rToProc = Range("A1", Cells(Rows.Count, "A").End(xlUp))
     Set fItem = Columns(1).SpecialCells(xlCellTypeConstants, 23).Cells(1, 1)’★
     Set fDetail = rToProc.Offset(fItem.Row).Find(What:=fItem.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

     For Each cel In Range(fItem, fDetail.Offset(-1)).SpecialCells(xlCellTypeConstants, 23)’★
         If Application.CountIf(Columns("A"), cel) <> 2 Then
             MsgBox fItem.Value & "がA列に2個未満、または2個超になっています。"
             Exit Sub
         End If
     Next
     MsgBox "データの在り様は想定通りです"
 End Sub

（keiji） 2019/06/24(月) 16:03

上の★消し忘れました。
（keiji） 2019/06/24(月) 16:04

 そんな所で出ちゃったですか。。(想定通りでないことは明らかですが）
 以下に貼り替えてやってみて下さい。

 Sub triral()
     Dim rToProc As Range
     Dim fItem As Range
     Dim fDetail As Range
     Dim cel As Range

     Set rToProc = Range("A1", Cells(Rows.Count, "A").End(xlUp))
     Set fItem = Columns("A").SpecialCells(xlCellTypeConstants, 23).Cells(1, 1)
     Set fDetail = rToProc.Offset(fItem.Row).Find(What:=fItem.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

     If fDetail Is Nothing Then
         MsgBox "工事名「" & fItem.Value & "」は、A列に1個しかないです"
         Exit Sub
     End If

     For Each cel In Range(fItem, fDetail.Offset(-1)).SpecialCells(xlCellTypeConstants, 23)
         If Application.CountIf(Columns("A"), cel) <> 2 Then
             MsgBox fItem.Value & "がA列に2個未満、または2個超になっています。"
             Exit Sub
         End If
     Next
     MsgBox "データの在り様は想定通りです"
 End Sub

（半平太） 2019/06/24(月) 16:05

 ＞     Set fItem = Columns(1).SpecialCells(xlCellTypeConstants, 23).Cells(1, 1)’★

 あれ？　その行でですか？？

 １．A列の最初のデータは何行目に入っていますか？

 ２．それは「1.○○工事」と同じ種類のデータですか？

（半平太） 2019/06/24(月) 16:11

＞１．A列の最初のデータは何行目に入っていますか？
見出し行が最初で3.4行目となります　"品　　　　名"　というデータです。

＞２．それは「1.○○工事」と同じ種類のデータですか？
中項目の始まりはA5からです。

Sub triral()実行に結果は以下です。
工事名「品名」は、1個しかないです
でした。
（keiji） 2019/06/24(月) 16:37

（半平太）さん
以下の件ですが、やはり諸経費という項目は、中項目で１回　それと
内訳明細の最終ページにもう１回でますのでこれが中項目と内訳明細の区切りと判断するのは難しいかな思います。内訳明細の部分をアクティブにしてからマクロを実行するような形が、いいのかと思いますがいかがですか？

 ＞中項目の始まりはA5からです。

 なら、これでどんなメッセージが出るか調べてください。

 Sub triral()
     Dim rToProc As Range
     Dim fItem As Range
     Dim fDetail As Range
     Dim cel As Range

     Set rToProc = Range("A5", Cells(Rows.Count, "A").End(xlUp))
     Set fItem = rToProc.SpecialCells(xlCellTypeConstants, 23).Cells(1, 1)

     Set fDetail = rToProc.Offset(fItem.Row).Find(What:=fItem.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

     If fDetail Is Nothing Then
         MsgBox "工事名「" & fItem.Value & "」は、A列に1個しかないです"
         Exit Sub
     End If

     For Each cel In Range(fItem, fDetail.Offset(-1)).SpecialCells(xlCellTypeConstants, 23)
         If Application.CountIf(Columns("A"), cel) <> 2 Then
             MsgBox fItem.Value & "がA列に2個未満、または2個超になっています。"
             Exit Sub
         End If
     Next
     MsgBox "データの在り様は想定通りです"
 End Sub

（半平太） 2019/06/24(月) 17:02

以下が、メッセージです
Ａ.○○○工事がＡ列に2個未満、または2個超になっています。
（keiji） 2019/06/24(月) 17:32

 ＞以下が、メッセージです 
 ＞Ａ.○○○工事がＡ列に2個未満、または2個超になっています。

 ・・で、その指摘は正しいですか？

 本来、2個ジャストじゃないとならないハズですが。。

（半平太） 2019/06/24(月) 17:39

＞本来、2個ジャストじゃないとならないハズですが。。
あっ、そういうことですか
失礼しました。これについてはお詫びしなくてはなりません
実は、以下のようにページの頭に合算グループ名を書いてしまっています。

以下中項目
全体グループ名
Ａ．×××工事
1.○○工事
2.△△工事
　1）○△工事
　2）×◎工事
3.□◎工事

Ｂ．×◎△工事
1.□○工事
2.□×工事

以下内訳明細（各始まりページの先頭）
Ａ．×××工事
1.○○工事

Ａ．×××工事
2.△△工事
　1）○△工事

Ａ．×××工事
2.△△工事
　2）×◎工事
このような感じです。
申し訳ございません。
なので複数Ａ．×××工事（大項目）は存在してしまいます。

（keiji） 2019/06/24(月) 17:59

訂正
なので複数Ａ．×××工事（大項目）は2個以上存在してしまいます。
（keiji） 2019/06/24(月) 18:05

 １．今回、中項目の行に小計額を引っ張ってくる計画だと思いますが、
 　　当然、大項目の行は何もしないことになります。

 　　同じA列に大項目と中項目が存在していますが、エクセル君にどうやって、
 　　その行は大項目だから何もしないでいいんだよ、と言い聞かせればいいんでしょうか？
 　　大・中が明確に区別出来るなら、大項目名は何個であろうとも無害ですけど・・

 ２．ちょっと不安になったんですが、下のようになる事は絶対に無いんですか？

 Ａ．×××工事 
 1.○○工事 
 Ａ．×××工事 
 2.△△工事 
 　1）○△工事 
 　2）×◎工事

 Ｂ．□□工事 
 1.●●工事 
 Ｂ．□□工事 
 2.△△工事 　　　←ここが大項目「Ａ．×××工事」の中項目と全く同じになる。

（半平太） 2019/06/24(月) 19:34

＞２．ちょっと不安になったんですが、下のようになる事は絶対に無いんですか？
このパターンはありません。
よろしくお願いします。
（keiji） 2019/06/24(月) 19:39

 ＞　大・中が明確に区別出来るなら

 このロジックは？

（半平太） 2019/06/24(月) 19:52

 ＞ 　Ａ．×××工事 
 ＞ 　1.○○工事 
 ＞ 　2.△△工事 
 ＞ 　　1）○△工事 
 ＞ 　　2）×◎工事 
 ＞ 　3.□◎工事

 考えたら、中・小を区別するロジックも必要です。

（半平太） 2019/06/24(月) 20:26

 ＞考えたら、中・小を区別するロジックも必要です。

 と言うか、小項目も引っ張て来る側にあったら、内訳明細とどこが違うんですかねぇ・・

（半平太） 2019/06/24(月) 20:48

＞＞　大・中が明確に区別出来るなら
＞このロジックは？
アルファベット/数字？かな

＞＞考えたら、中・小を区別するロジックも必要です。
＞と言うか、小項目も引っ張て来る側にあったら、内訳明細とどこが違うんですかねぇ・・
中項目内の小項目の位置づけ　1）　2）で中項目として成り立つためこのときは
小項目のみ「小計」があります。（明確な論理はありません）
小項目のない中項目だけのものはそのまま「小計」が来ます。
詳しく判断はできないのですが例えば　1.○○工事を読んで
下方向で最初に現る「小計」を探すみたいなことは可能でしょうか？
なにか法則（決まりが無いと）難しいでしょうかね。
（keiji） 2019/06/24(月) 21:57

＞ 2.△△工事　　　←ここが大項目「Ａ．×××工事」の中項目と全く同じになる。
よくよく考えると無いとはいえないケースがあります。<(_ _)>

（keiji） 2019/06/25(火) 03:03

 ＞＞ 2.△△工事 　　　←ここが大項目「Ａ．×××工事」の中項目と全く同じになる。 
 ＞よくよく考えると無いとはいえないケースがあります。<(_ _)>

 前の回答は信じていなかったです　＾＾
 まぁ、まとめ側も、内訳明細側も、出現順序が同じなので、この問題はクリアできます。

 けど、これを何とかしなとならないです。
 　　　　↓
 ＞詳しく判断はできないのですが例えば　1.○○工事を読んで 
 ＞下方向で最初に現る「小計」を探すみたいなことは可能でしょうか？ 
 ＞なにか法則（決まりが無いと）難しいでしょうかね。

 私としては、「小計」から上方向に調べていき、
 「○○なら××の行にあるのが項目名だ」と言う決まりが無ければ無理と考えます。

 明細がどんな書き方をしているのかよく分からないです。

 私の想像では下図ですが、実際にあり得るパターンを提示して貰わないと、
 こっちでは何ともならないです。

 そもそも、規則性を説明するのはそっちの役割なんですからねぇ・・

 -----------------
  <ロジック例>

 ※下図の列番号は無視してください。

  ______A______ ___B___ _C_ _____D_____ ___E___ _F_ _____G_____ ___H___ _I_ _____J_____ ___K___
  内訳２つ以上              内訳が一つ              内訳が一つ              内訳が一つ         
  　　例1       金額欄      　　例2     金額欄      　　例3     金額欄      　　例4     金額欄 
  Ａ．×工事                Ａ．×工事              Ａ．×工事              Ａ．×工事         
  kk1                       kk1                     kk1            110      kk1            110 
  kk2              110      kk2            110      小計           110      小計           110 
  kk3              110      小計           110                              kk2          1,100 
  小計             220                                                      小計         1,100

 １．内訳が２つ以上ある場合
 　例１(典型例)は、「小計」からさかのぼって金額欄が空欄なら、その行に「中項目名」がある。

 ２．内訳が１つしかない場合
 　※例２の様に書くのか、「例３とか例４」の様に書くのか不明

 　例２と書くなら、上記１と同じロジックで探せる。

 　例３の様に書く場合、金額が空欄の行を探して、大項目(左1文字がアルファベット)なら、その下の行を採用する。

 　例４の様に書く場合、金額が空欄の行を探しても、kk2は素通りされてしまうので、小計にぶち当たったら、その下の行を採用する。

（半平太） 2019/06/25(火) 13:10

＞そもそも、規則性を説明するのはそっちの役割なんですからねぇ・・
そうですよね！

件名毎パターンがいろいろなので基本パターンは以下です。が
Ａ．×××工事
1.○○工事
以下内訳明細
・
・
小計

中項目内にその子項目がある場合
Ａ．×××工事
1.○○工事
　1）□△
以下内訳明細
・
・
小計

＞１．内訳が２つ以上ある場合
＞　例１(典型例)は、「小計」からさかのぼって金額欄が空欄なら、その行に「中項目名」がある。
この通りです。
＞２．内訳が１つしかない場合
例２の書き方です。
＞例３の様に書く場合
この書き方はありません
例４はありません
むぅー規則性ですよね
例えば中項目のＭ列をアクティブにしてその項目で下方向で探し「小計」の位置（セル）
番号を転記のような感じでは、無理ですかね？（ココに探し出す方法）

中項目

     A　　　　　　　　　　　　　　　　　　　　　　　　　　M
 Ａ．×××工事 
 1.○○工事　　　　　　　　　　　　　　　　　　　　　　ココをClick後マクロ操作 
 Ａ．×××工事 
 2.△△工事　　　　　　　　　　　　　　　　　　　　　　　該当なし 
 　1）○△工事 　　　　　　　　　　　　　　　　　　　　ココをClick後マクロ操作
 　2）×◎工事
（keiji） 2019/06/25(火) 14:05

 ＞例４はありません 
 と言うことは、必ずこうなるんですか？
 　　　　　　　　↓
   _____J_____  ___K___
   内訳が一つ          
   　　例4      金額欄 
   Ａ．×工事          
   kk1                 
   kk2             110 
   小計            110 
   kk3                 
   kk4           1,100 
   小計          1,100

 なら、例１と同じロジックで特定可能です → kk2とkk2が中項目

 ＞例えば中項目のＭ列をアクティブにしてその項目で下方向で探し「小計」の位置（セル） 
 ＞番号を転記のような感じでは、無理ですかね？（ココに探し出す方法）

 あのー、何が中項目名に該当するのか分からないので苦労しているんですが・・

（半平太） 2019/06/25(火) 14:25

 ＞ (誤)　例１と同じロジックで特定可能です → kk2とkk2が中項目

 　 (正)　例１と同じロジックで特定可能です → kk1とkk3が中項目

（半平太） 2019/06/25(火) 16:00

＞＞例４はありません
＞と言うことは、必ずこうなるんですか？
はい、この通りです。（中間小計kk3の間にＡ．×工事あります）

   _____J_____  ___K___
   内訳が一つ          
   　　例4      金額欄 
   Ａ．×工事          
   kk1                 
   kk2             110 
   小計            110
改ペーシ
   Ａ．×工事  
   kk3                 
   kk4           1,100 
   小計          1,100 
この場合kk1、kk3が相当します。

改ペーシ
子がいる場合

   Ａ．×工事
   kk5 中項目ですが子がいます
   kk3      子の方がすくい上げたい項目となります           
   kk4           1,100 
   小計          1,100

＞あのー、何が中項目名に該当するのか分からないので苦労しているんですが・・
申し上げにくいですが、特定の規則性がないですね
あえて言うなら中項目名のしまいは「小計」ぐらいです。
複雑すぎますか？
（keiji） 2019/06/25(火) 16:11

 ＞特定の規則性がないですね

 ですから、これが特定の規則じゃないんですか？
 　　　　　　↓
 「小計」からさかのぼって金額欄が空欄なら、その行に「中項目名」がある。

 この例外がないかどうか確かめるために、ここ数レス、お聞きしているんですが。

（半平太） 2019/06/25(火) 16:25

＞「小計」からさかのぼって金額欄が空欄なら、その行に「中項目名」がある。
そういうことですか(-_-)
そうです、そうですね　そのとおりでした。
小計からさかのぼり、最初の金額欄が空欄が、中項目です。そうですm(_ _)m
（keiji） 2019/06/25(火) 18:00

 ＞そのとおりでした。

 それを信じるとして、・・
 後記マクロで試してください。

 見積書の「シートモジュール」に貼り付けて実行。

 Sub setFmla()
     Dim rToProc As Range
     Dim rToLookup As Range '絞り込んだ検索範囲
     Dim FoundRW As Long
     Dim LookEnd As Long
     Dim fItem As Range
     Dim fDetail As Range
     Dim cel As Range
     Dim RW As Long
     Dim SubTTLrows() As Long '小計のある行番号を格納　0番目は「小計」の数を管理する
     Dim i As Long
     Dim fRW As Long

     Set rToProc = Range("A5", Cells(Rows.Count, "A").End(xlUp)) '処理範囲A列を取得

     ReDim SubTTLrows(0 To 0)

     '小計の行番号を格納
     SubTTLrows(0) = 1
     ReDim Preserve SubTTLrows(0 To 1)

     Set fDetail = rToProc.Find(What:="小計", LookIn:=xlValues, LookAt:=xlWhole)
     SubTTLrows(1) = fDetail.Row

     Do
         Set fDetail = rToProc.FindNext(fDetail)
         If fDetail.Row <> SubTTLrows(1) Then
             SubTTLrows(0) = SubTTLrows(0) + 1
             ReDim Preserve SubTTLrows(0 To SubTTLrows(0))
             SubTTLrows(SubTTLrows(0)) = fDetail.Row
         Else
             Exit Do
         End If
     Loop

     '各小計行について順々に処理

     Set rToLookup = Range("A5:A" & SubTTLrows(1) - 1)

     LookEnd = 0
     For i = 1 To SubTTLrows(0)
         For RW = SubTTLrows(i) - 1 To 5 Step -1     '上方へ探索
             If IsEmpty(Cells(RW, "H").Value) Then   '金額欄が空白→中項目項目発見　RW

                 If LookEnd = 0 Then '検索範囲上限を記憶
                     LookEnd = RW - 1
                 End If

                 If IsEmpty(Cells(RW, "A").Value) Then
                     MsgBox SubTTLrows(i) & "行の小計に対応する中項目セル(A列)が空白です。処理中止"
                     Exit Sub
                 Else
                     FoundRW = rToLookup.Find(Cells(RW, "A").Value).Row
                     Cells(FoundRW, "A").Range("M1").Formula = "=H" & (SubTTLrows(i))

                     Set rToLookup = Range("A" & FoundRW + 1 & ":A" & LookEnd)  '次回の検索範囲を絞る
                 End If
                 Exit For
             End If
         Next RW

         If RW < 5 Then
             MsgBox SubTTLrows(i) & "行の小計に対応する中項目が特定できません。処理中止"
             Exit Sub
         End If
     Next i
 End Sub

（半平太） 2019/06/25(火) 19:45

＞見積書の「シートモジュール」に貼り付けて実行。
えっ標準モジュールでは？
シートモジュールだと「開発」「マクロ」に出現しないのですが動かす方法？

一応標準モジュールで実行してみたのですが
「250行の小計に対応する中項目が特定できません。処理中止」
と出て終了してしまいました。
250行を、確認したところ　最初に（上から）なぞり最初にある小計でした
ここの遡り確認すると以下のようになっています

         A
130　 Ａ．×工事 
131
132
133
134   １.△□工事
135
136    １）○△工事
137
138
139
140内訳明細スタート下へ続く
141
142

・
・
250　　小計
このような配置なんですがいかがでしょうか？

（keiji） 2019/06/25(火) 20:20

 ＞＞ 「小計」からさかのぼって金額欄が空欄なら、その行に「中項目名」がある。 
 ＞そういうことですか(-_-) 
 ＞そうです、そうですね　そのとおりでした。 
 ＞小計からさかのぼり、最初の金額欄が空欄が、中項目です。そうですm(_ _)m

 それを信じたんですけど、その通りじゃなかったんですか？
 そちらの配置図では何も判別できないです。

 ＞＞見積書の「シートモジュール」に貼り付けて実行。 
 ＞えっ標準モジュールでは？ 
 ＞シートモジュールだと「開発」「マクロ」に出現しないのですが動かす方法？

 そんな筈ないと思うんですけど、Sheet1!setFmla とか出てないですか？

（半平太） 2019/06/25(火) 20:28

＞そんな筈ないと思うんですけど、Sheet1!setFmla とか出てないですか？
すみません。ありました。
＞そちらの配置図では何も判別できないです。
空白行があると無理なのでしょうか？(空白行はあまり関係ないと思ってました)
残念ですが
あきらめるしかないでしょうか（手作業でやりますかね）
条件が多過ぎでしょうかね(^^;)
いろいろ熱心にお考えいただき感謝しております。
ありがとうございました。

（keiji） 2019/06/25(火) 20:36

 ＞あきらめるしかないでしょうか（手作業でやりますかね）

 私に言われましてもねぇ・・私の仕事じゃないですから。

 3000の手作業の効率化を諦めらる人は先ずいないでしょうが、
 もうちょっと真面目に「小計からさかのぼって中項目名がある行を見つける方法」を考えたら如何ですか？

 ＞空白行があると無理なのでしょうか？
 無理じゃないです、

 ＞(空白行はあまり関係ないと思ってました) 
 関係ない訳ないですよね。

 金額欄が空欄なら、その行に「中項目名」がある、と言うロジックにしたんですから、
 空白行なら当然金額欄も空白ですから、ミスジャッジするに決まっているじゃないですか。

 そうなると、「ただし、金額欄が空白でも、全行が空白の行ならそれは無視してさかのぼり探索を継続する」
 とか言ってもらわないと。

 果たして、それだけで中項目名にたどり着けるのか、こっちは分からないです。

 ご自分が知悉している表なんですから、ちゃんと分析してくださいよ。

（半平太） 2019/06/25(火) 20:58

書いている間に話が進んでましたが、投稿しておきます。

＞えっ標準モジュールでは？
横からですけど、とりあえず、貼り付ける場所はわかりますかね？
http://officetanaka.net/excel/vba/beginner/10.htm

VBE（エディタの）画面をよくみると、↓みたいになっているとおもいます。

 VBAProject
 └Microsoft Excel Objects
    └Sheet1(Sheet1)         ←★シートモジュール
 └標準モジュール
     └Module1               ←■標準モジュール

このうち、該当シートのシートモジュールに貼り付けてと言われてい（るとおもい）ます。

＞シートモジュールだと「開発」「マクロ」に出現しないのですが動かす方法？
べつにシートモジュールに書いても出てきますよ

試しに適当な新規ブックを用意して↓をSheet1のモジュールに貼り付けてみてください。

    Sub さんぷる()
        MsgBox "こんにちは"
    End Sub

↑を貼り付けてから、「開発」「マクロ」で、マクロ保存先を【作業中のブック】or【開いているすべてのブック】にしてみると、Sheet1.さんぷる　というのがでてくるとおもいます。
（要は、【Private】 Sub ～　でなければ、出てくる仕組みです）

また、「動かす」部分に関して言えば、いちいちそんなところから選ばなくても、エディタ画面でカーソルを該当のプロシージャに置いてる状態で右向き三角をおせば実行できます。もちろんメニューの「実行」のSub／ユーザーフォームの実行　でも出来ますしショートカットであるF5を押しても実行できます。

また、そのようなことを仰ると言うことは、ステップ実行をご存じないような気がします。
マクロに手を出すなら、基礎中の基礎のテクニックだとおもいますので、まずはこちらをみておいたほうがよいとおもいます。
https://www.239-programing.com/excel-vba/basic/basic023.html

（もこな２） 2019/06/25(火) 21:17

 あれー、変だなぁ・・

 A列が空行の場合、こうなる筈ですけども。
 　　　　　　　　　　↓
 　「250行の小計に対応する中項目セル(A列)が空白です。処理中止」

 ＞「250行の小計に対応する中項目が特定できません。処理中止」 
     　　　　　　　　　　　　　　 ↑
 　　　　　　　　　　  　  本当にこの文言でしたか？

（半平太） 2019/06/25(火) 22:03

（半平太）さん
＞私に言われましてもねぇ・・私の仕事じゃないですから。
＞ 3000の手作業の効率化を諦めらる人は先ずいないでしょうが、
＞もうちょっと真面目に「小計からさかのぼって中項目名がある行を見つける方法」を考え＞たら如何ですか？
＞＞空白行があると無理なのでしょうか？
＞無理じゃないです、
ありがとうございます。男気全開ですね
ここまでお付き合い頂いたのですから、気合いを入れ直します。
諦め掛けた自分が情けないです。(-_-)

気を取り直して　えーと、小計からさかのぼり中項目を見つけるですよね
その前にすぐ前の質問ですが空白行を除き、さかのぼり金額のあるすぐ上のセルに
中項目を移動し、マクロテストしてみました。
やはり、警告は一緒で↓こちらです。また最初移動前も一緒です。
「250行の小計に対応する中項目が特定できません。処理中止」
ちなみに250行目の中項目名は、136行目です。

それと、空白行は、中項目にたどり着くまでいたるところに存在します。
なぜならメールの文章ではないですが、ひとかたまり（グループ分けのような感じ）で
内訳明細を作成しているためです。(グループ群が長いのでみやすくするために)
ひとかたまり終了すると4～6行（偶数）程度空けて内訳明細続け最後に「小計」となります。

＞もうちょっと真面目に「小計からさかのぼって中項目名がある行を見つける方法」を考えたら如何ですか？
＞果たして、それだけで中項目名にたどり着けるのか、こっちは分からないです。
＞ご自分が知悉している表なんですから、ちゃんと分析してくださいよ。
それは、そうなんですがやはりいくら考えても規則性がありません。
アルファベットの書き込みがある　金額で追いかけるなどなどですが規則性なし

やはり途中書きましたが

 中項目名一覧ページ／（主に1～2ページ目を利用）
以下のように１つずつクリックしその行のＡ列の中項目名から内訳明細項の中項目
同名を下方向に探り、小計を特定し、セル番地(Ｈ列)を入れるしか無いように
思えます。規則性はその程度しか特定できません。空白行おおすぎなので:-)
いかがでしょうか？

     A　　　　　　　　　　　　　　　　　　　　　　　　　　M
Ａ．×××工事 
1.kk1工事　　　　　　　　　　　　　　　　　　　　　　 ココをClick後マクロ操作 
2.kk2工事　　　　　　　　　　　　　　　　　　　　　　　該当なし 
 　1）kk3工事 　　　　　　　　　　　　　　　　　　　　ココをClick後マクロ操作
 　2）kk4工事 　　　　　　　　　　　　　　　　　　　　ココをClick後マクロ操作
3.kk5工事
4.　　　　　　　　　　　　　　　　　　　　　　 　　　　ココをClick後マクロ操作

（もこな２）さん
これについては解決しました。Ｆ8キーなどでステップ実行もしてみました。
ありがとうございました。
（keiji） 2019/06/26(水) 01:45

 ＞思えます。規則性はその程度しか特定できません。空白行おおすぎなので:-)
 ＞いかがでしょうか？

 いいですけど、クリックは右Clickにしたい。(左Clickは使いにくいので）

 ロジックは以下とします。

 同名問題があるので、M列を右クリックすると、
 その行のA列セル(中項目名)が、A列全体で幾つあるか、まず調べる。

 奇数あった場合
 　対応関係がおかしいので「奇数-対応不可」と表示する

 偶数あった場合
 　例えば6個あった場合で、右クリックしたのが2番目なら、
 　1:4、2:5、3:6　がそれぞれ対になる筈なので、
 　5番目にある項目行の下方にある最初の小計の数値が反映する様に数式を作って、
 　右クリックしたセルに埋める。

 見積書のモジュールに下記コードを貼り付ければ、準備完了

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     Dim App As Application
     Dim rToProc As Range
     Dim Scope As String     '範囲のアドレス
     Dim tgtName
     Dim Num, OrderSRC, OrderAimed         '総数、検索値の番目、目標の番目
     Dim lastRW As Long
     Dim PosAimed
     Dim TTLrw

     If Target.CountLarge <> 1 Then Exit Sub
     If Intersect(Target, Columns("M")) Is Nothing Then Exit Sub

     tgtName = Target.EntireRow.Range("A1").Value
     If IsEmpty(tgtName) Then Exit Sub

     Cancel = True
     Set App = Application

     lastRW = Cells(Rows.Count, "A").End(xlUp).Row
     Set rToProc = Range("A5:A" & lastRW) '処理範囲A列を取得
     Scope = rToProc.Address

     Num = App.CountIf(rToProc, tgtName) '何個あるか調査

     If Num = 0 Or App.IsOdd(Num) Then
         Target.Value = "奇数-対応不可"
         Exit Sub
     End If

     OrderSRC = App.CountIf(Range("A5:A" & Target.Row), tgtName) '何番目か調査
     OrderAimed = Num / 2 + OrderSRC
     PosAimed = App.Evaluate("AGGREGATE(15,6,ROW(" & Scope & ")/(" & Scope & "=""" & tgtName & """)," & OrderAimed & ")")

     TTLrw = App.Match("小計", Range("A" & PosAimed + 1 & ":A" & lastRW), 0) + PosAimed
     Target.Formula = "=H" & TTLrw
 End Sub

（半平太） 2019/06/26(水) 10:06

（半平太）さ～ん
すごいです。いろいろパターンでやってみてます。
現在、非常に快調です。
あきらめなくて良かったです。
仕事はかどります。感謝感謝
しかしながら。マクロの内容はさっぱり分かりません
ほかに代用とかメンテナンス程度はできるようになりたいのですが
まだまだ無理そうです。RightClickも正解です。（間違え減りそう）
なんでこんなマクロがちょいちょいとできてしまうのか不思議です。
全てのプロパティとかお解りなんでしょうね？
とにかく、便利に使わせていただきます。m(_ _)m
ありがとうございました。
また、相談させて貰うと思いますがよろしくお願いします
（keiji） 2019/06/26(水) 19:19

コメント返信：

[ 一覧(最新更新順) ]

[[20190623201818]] 『項目ごとの小計を抽出するには』（keiji） ページの最後に飛ぶ

[[20190623201818]]　『項目ごとの小計を抽出するには』（keiji）　ページの最後に飛ぶ