マクロでシートからシートへの数式をいれる

ｺｰﾄﾞがわかりません。

条件

①ｼｰﾄA種目　と　ｼｰﾄA科目　があり
②A種目　に　数式をいれるのが目的
③三行で一式になる表
④上から順番にA科目のB列に計がある時
⑤A種目に数式　=A科目!E○○　を代入
⑥○○は計の一つ下の行のE列のセルになる
⑦数式を入れるセル　A種目のC列に数値1がある行のE列

何と何をくみあわせればいいのかわかりません。

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

• 

  https://gyazo.com/ba552b516ec77045669875940e65da8d
  https://gyazo.com/fdbc3fb1557c7b6ac0eed7ee038b97bd
  画像添付しました。
  
  ＞A科目のB列に計がある時
  ＞A種目のC列に数値1がある行
  
  対になる同じ数量だけあります。
  表で種目別のｾﾙE6に数式=A科目!E48がはいります。
  
  種目・科目　共に間に小計などもでてきますが、【計】の数と【１式】は同じ数だけ必ずあります。
  そして、上から順番に対になっています。

  No.1の回答に寄せられた補足コメントです。 補足日時：2021/04/01 10:43

• 補足です。
  1.
  A種目の
  第三区画
  棚X
  第三区画
  棚Y
  第三区画
  棚Z
  第七区画
  棚Z
  の順に
  科目の方も上から同じ順番で計が並んでいます。
  この順番はかわりません。
  2.
  基本的には半角スペースが二つ入っています。
  しかし、これはあくまでもこのケースなので、別の違うカテゴリーになると、第○○区画だけになったり在庫棚とかだけの表記になります。第〇区画 棚□のグループ分けだけでは無いのですよ・・・
  3.
  予備区画などの一単語にはスペースははいりません。
  4.
  B3はセル結合していません。線がないだけで、単一セルになっています。
  
  ※絶対に揺るがな法則は種目の順番に科目の計が並んでいることですね。
  
  ややこしくてすみません。

  No.5の回答に寄せられた補足コメントです。 補足日時：2021/04/02 10:07

• 補足です
  あらたに発見したのですが
  科目に第三区画 棚X　とありますが
  このパターンの他に、一単語（予備区画）などのほかに
  販売物第五区画 棚J
  郵送物第一区画 棚８
  などの場合もでてきます。
  そして種目には
  これがわけて表記されています。
  二行で
  販売物□□□
  第五区画□□棚J
  □は半角スペースです。
  実際、半角スペースがどこに何個入っているのかはランダム過ぎて困っています。

  No.6の回答に寄せられた補足コメントです。 補足日時：2021/04/02 10:21

• 

  一点だけ補足ぬけがありました
  種目表のカテゴリーがかわる時に計で一旦しめるのですが
  行数が多いと同じ形態の表がつぎのページにあり。そこに小計や計がきます
  その後、新たな同形態のページから項目がはじまります
  その時にうまく判断してくれなくて小計三行の上段に＝科目＃＃が入ってしまいます
  そしてその下のページまで読み取ってくれません

  No.8の回答に寄せられた補足コメントです。 補足日時：2021/04/02 11:36

• 

  続きです
  種目のページがかわる例
  ---------------------------------------1ペー
  種目別内訳
  名称
  ○○　1式　＝科目＃＃　
  小計　　　 □□円
  ○○　1式　＝科目＃＃
  ----------------------------------------2ペー
  種目別内訳
  名称
  　　上段　　＝科目＃＃　←これがくる
  小計　　　 □□円　　　
  計　 　□□□□円
  [
  [
  [
  [
  
  [
  ----------------------------------------3ペー
  種目別内訳
  [
  名称
  ○○　1式　　　←ここまでこない
  ○○　1式　
  計　　　　□□円

  No.9の回答に寄せられた補足コメントです。 補足日時：2021/04/02 11:37

• 

  https://gyazo.com/41b5db6ea707502cf106c9c5cca615a4
  
  雑ですがページはこのような感じです。

  No.11の回答に寄せられた補足コメントです。 補足日時：2021/04/02 13:10

No.1 回答者： めぐみん_ 回答日時： 2021/03/31 15:36

どんな表とどんな表？とで処理をしなきゃいけないのか。

今回のは画像がないのでしょうか？
あと数式を入れていくってのも何を基準に入れるかはわかりますが、そこに入れる数式がどれなのか？と言うのはどうやって決めるのでしょう？

＞A科目のB列に計がある時
＞A種目のC列に数値1がある行

この２つって対になる同じ数量だけあるのですか？
そして上から順に相互が組になっていて入れていけばいい？

No.2 回答者： めぐみん_ 回答日時： 2021/04/01 14:12

データは提示して頂いたものよりかなりいい加減ではありますが目的の、

・Ａ科目にある計の１つ下のＥ列のアドレスを使い数式とする。
・Ａ種目の上記数式はこのシートのＣ列に1があった場合は、同行のＥ列にＡ科目で該当した数式を順に当てはめる。

は叶えているはずです。
ご検証願います。

Sub megu_2()
Const ws1 As String = "Ａ科目" '集計元のシート名
Const ws2 As String = "Ａ種目" '集計先のシート名
Const ws1_f As String = "=Ａ科目!En" '集計先への参照元名＋列文字＋秒番号の仮文字(n)
Dim myDic As Object
Dim r As Range, rr As Range, n As Long

Set myDic = CreateObject("Scripting.Dictionary")
n = 1

With Worksheets(ws1)
.Range("B4:F" & .Cells(Rows.Count, "D").End(xlUp).Row).AutoFilter 1, "計"
For Each r In .Range("B5", .Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible)
myDic.Add n, r.Offset(1).Row
n = n + 1
Next
.Cells.AutoFilter
End With

n = 1

With Worksheets(ws2)
.Range("B4:F" & .Cells(Rows.Count, "D").End(xlUp).Row).AutoFilter 2, 1
For Each r In .Range("C5", .Cells(Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible)
If n > myDic.Count Then Exit For
r.Offset(, 2).Formula = Replace(ws1_f, "n", myDic(n))
n = n + 1
Next
.Cells.AutoFilter
End With
Set myDic = Nothing

End Sub

コード最初のシート名と数式については適宜修正をお願いします。

この回答へのお礼

お返事ありがとうございます。

検証結果ですが。

With Worksheets(ws1)
.Range("B4:F" & .Cells(Rows.Count, "D").End(xlUp).Row).AutoFilter 1, "計"
For Each r In .Range("B5", .Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible)
myDic.Add n, r.Offset(1).Row
n = n + 1
Next
.Cells.AutoFilter
End With

n = 1

With Worksheets(ws2)
.Range("B4:F" & .Cells(Rows.Count, "D").End(xlUp).Row).AutoFilter 2, 1
For Each r In .Range("C5", .Cells(Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible)
If n > myDic.Count Then Exit For
----------------------------------------------------------
r.Offset(, 2).Formula = Replace(ws1_f, "n", myDic(n))
----------------------------------------------------------
↑この位置でデバッグ
n = n + 1
Next
.Cells.AutoFilter
End With
Set myDic = Nothing
End Sub
----------------------------------------------------------
r.Offset(, 2).Formula = Replace(ws1_f, "n", myDic(n))
----------------------------------------------------------
重複しない条件と言うことになると　計値が同じ数値になる場合に反応しないと言う事になるのでしょうか？

お礼日時：2021/04/01 15:44

No.3 回答者： めぐみん_ 回答日時： 2021/04/01 16:11

＞重複しない条件と言うことになると　計値が同じ数値になる場合に反応しないと言う事になるのでしょうか？

の意味が良くわかりません。

＞そして、上から順番に対になっています。

基本取得した順に該当する場合は代入していくだけです。
他に条件があるとかは考慮してません。
あとエラーの場合はそのエラーの内容を提示して下さい。
まずは私が作成したダミーデータのようなもので結果がキチンと出ているのか確認し、それで問題ないのなら本番のコピーブックで検証が宜しいかも。

No.4 回答者： めぐみん_ 回答日時： 2021/04/01 18:28

そこのエラーで思い当たるとしたら、

Const ws1_f As String = "=Ａ科目!En" '集計先への参照元名＋列文字＋行番号の仮文字(n)

数式にするこの部分でシート名（全角半角含め）の違いかセルのＥや最初のが全角になっている、間の ! が抜けているとかかな。

この回答へのお礼

できました。
コードを間違えていました。
お力添えありがとうございました。

お礼日時：2021/04/02 11:56

No.5 回答者： tatsumaru77 回答日時： 2021/04/01 19:44

補足要求です。

１．A科目の最初の計は、B3に「第三区画　棚X」があり、この「計」の次の行のE48のセルが対象となります。
これに対応するA種目は、B5、B6の第三区画,棚Xになります。
あなたが提示されたサンプルでは１例だけなので、以下の判断が付きません。
A種目は、
第三区画,棚X
第三区画,棚Y
第三区画,棚Z
第七区画,棚Z
第七区画,棚J
・・・のように並んでますが、
A科目も
上記のならびに完全に一致して
第三区画　棚X
第三区画　棚Y
第三区画　棚Z
第七区画　棚Z
第七区画　棚J
・・・とならんでいるのでしょうか。
それとも、以下のように並びは、ばらばらの場合もあるのでしょうか。
第七区画　棚Z
第三区画　棚Z
第七区画　棚J
第三区画　棚Y
第三区画　棚X

２．A科目は、B3に「第三区画　棚X」がありますが、
この第三区画と棚Xとの間の空白は、どうなっていますか。
①半角スペースが１つ
②半角スペースが１つ又は２つ以上
③全角スペースが１つ
④全角スペースが１つ又は２つ以上
⑤半角スペースと全角スペースが混在
上記の①～⑤のどれになりますか。

３．A種目には、「予備区画」がありますが、
これに対応するA科目では、「予備区画」となっていますか。（前後に空白が付くことはないですか）

４．A科目は、B3に「第三区画　棚X」とありますが、これがA種目と対応させるときの、キーとなります。
「第三区画　棚X」と書かれているセルは結合セルとなっていますが、他のキーのセルも結合セルとなっていますか。
「第三区画　棚Y」、「第三区画　棚Z」のセルも結合セルですか。
要は結合セルにはキーが格納されているという判断をして良いかどうかの質問です。

A科目のB列には
・第三区画　棚X
・第一書類
・第二書類
等の文字があるが、マクロではどれがキーなのかが判断つかない為の質問です。
（人間は総合的に判断するので「第三区画　棚X」になりますが、マクロでは判断できません）

No.6 回答者： tatsumaru77 回答日時： 2021/04/01 19:50

No5です。

補足要求　２．ですが、
「第三区画　棚X」の間の空白の質問ですが、他のものついても同様です。
「第三区画　棚Y」
「第七区画　棚Z」
等の空白について質問しています。
（「第三区画　棚X」のみに限定して、質問しているわけではありません）

No.7 回答者： めぐみん_ 回答日時： 2021/04/02 05:58

基本的には。

＞A科目のB列に計がある時
⇒その１行下のＥ列の行番号を順次格納

＞A種目のC列に数値1がある行
⇒格納していた順に同行のＥ列に置換した数式を順にセットする

と言う事以外は何もしてません。
ベテラン様のように『他の語句がどのように存在しているからどうなるのか？』と言う考えは持たず上記の判断のみで実行したものです。
数式の元の文字列を書き違えていないと言うのなら、基本的にはエラーは出ないはずですよ。

ベテラン様もいらっしゃったようですので、あとはお任せ致します。
コードは破棄しても構いませんので。
多分データ数が多くてフィルターをかけられないのかも知れませんし。
⇒こちらでは簡易的に２万行ほどでも出来ましたけど、列数が少なかったため書き込まれているデータ数（使用しているセル数）の差が影響しているのかも。
なのでベテラン様のように地道に調べていくのが確実かもですね。

でも質問の度に書式が変わるとは、未だ書式が定まらないのか既に完成しているけど小出しで質問を変えていっているのか気にはなります。
そのＢｏｏｋを前にコードを書けばベテラン様なら３０分もかからず終わると思いますよ。
小出しで情報を増やすのは逆に手間になります。
解決したと思って検証用Bookを破棄したらまた質問が上がった事で再度Bookを作成するのはね。
たまたま消し忘れてたBookに追加質問が１年後に来た時は凄い偶然と思った事はありました。

この回答へのお礼

ありがとうございます。
すみません、ここで質問をするのがごく最近になってからだったので、勝手があまりわかっていませんでした。
以後、問題があればまとめて質問できるようならそうさせて頂きます。

お礼日時：2021/04/02 09:29

No.8 回答者： tatsumaru77 回答日時： 2021/04/02 10:33

以下のマクロを標準モジュールに設定してください。

Option Explicit

Public Sub 科目計設定()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim dicT As Object
Dim row1 As Long
Dim row2 As Long
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim key As String
Dim kctr As Long '科目の計のカウンター
Dim sctr As Long '種目のカウンター
Set sh1 = Worksheets("A種目")
Set sh2 = Worksheets("A科目")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
maxrow2 = sh2.Cells(Rows.Count, "B").End(xlUp).row 'B列の最大行取得
'科目の計の次の行を全て記憶する
kctr = 0
For row2 = 5 To maxrow2
If sh2.Cells(row2, "B").Value = "計" Then
kctr = kctr + 1
dicT(kctr) = row2 + 1
End If
Next
maxrow1 = sh1.Cells(Rows.Count, "B").End(xlUp).row 'B列の最大行取得
'種目に計を設定する
For row1 = 5 To maxrow1 Step 3
If sh1.Cells(row1, "B").Value <> "" And sh1.Cells(row1, "B").Value <> "小計" Then
sctr = sctr + 1
key = sh1.Cells(row1, "B").Value & " " & sh1.Cells(row1 + 1, "B").Value
If dicT.exists(sctr) = False Then
sh1.Activate
sh1.Cells(row1, "B").Select
MsgBox ("[" & key & "]は別紙明細に存在しません")
Exit Sub
End If
sh1.Cells(row1 + 1, "E").Formula = "=A科目!" & sh2.Cells(dicT(sctr), "E").Address(False, False)
End If
Next
If sctr <> kctr Then
MsgBox ("科目の件数=" & kctr & " 種目の件数=" & sctr & "が違いますが設定完了しました")
Else
MsgBox (sctr & "件設定完了")
End If
End Sub

この回答へのお礼

補足がぬけていてすみませんでした。
文章で書きましたが、説明下手なので、伝わるか心配です。

お礼日時：2021/04/02 11:49

No.9 回答者： tatsumaru77 回答日時： 2021/04/02 10:59

>実際、半角スペースがどこに何個入っているのかはランダム過ぎて困っています。

No8です。空白がどうなっているかの質問は、科目の計と種目の計がバラバラに並んでいる場合、それを名前で突き合わせるために質問しました。
科目と種目の並びが保障されているということなので、
名前の突き合わせは、不要になりました。
従って、空白がどのようになっているかを気にする必要はなくなりました。
No8のマクロでは、名前の突き合わせは行っていません。
但し、科目の計と種目の計の件数が不一致の場合は、エラーメッセージ（もしくは警告メッセージ）をだすようにしています。

No.10 回答者： めぐみん_ 回答日時： 2021/04/02 11:36

No.7です。

結局エラーの内容や数式の書き間違えの有無などの有力情報は放置ですか？

このサイトを利用する云々もですが、それぞれの質問でその前の質問が解決したにも関わらず類似した質問を繰り返すってなら、前の質問に対する回答の何が問題になったのかが『報連相』ではないかなと思います。
まだここは優しいですけど他だと前回の質問・解決したとされる回答についてから追及されるかもですよ。

＞A種目のC列に数値1がある行

についても『３行１組』の２行目って事ですが１行目や３行目には存在しないのか？と言う疑問もありますが、それでもコードのあの部分でエラーは起きないですしね。
それぞれの個数の確認であればCOUNTIFで始めに調べれば良いだけかもですし。
仮に１行目や３行目に存在するとしたら書き込まれている行番号を調べれば回避は可能でしょう。

★シートの保護でもかかっていたのだろうか？？？？？？★

この回答へのお礼

すみません。
情報量が多くて順次処理していきますので、お待ちください。
私自身もこの表を自分で作成したわけではなくて、この統一性がない表の属性を見極めるのに時間を要しているところです。
三行一組なので各項目に対して1式とあります。Ｄ列の各中段以外には何もはいりません。
ｼｰﾄの保護はかかっていなかったです。
全角かどうかのﾁｪｯｸは行いました。
今、ｺｰﾄﾞミスがないか、映し間違えがないかなど、探っています。
ご迷惑おかけしてすみません。

お礼日時：2021/04/02 11:46