VBAで名前検索と可視セル数値の別シート貼り付け

VBAに詳しい方、たすけてください。
Excel2010のVBAで下記のように動くプログラムを組んではいただけないでしょうか。

①ExcelのBook全体のＤ列をユーザーが入力した任意の文字で検索する(テ

キストボックスを表示する)
②検索結果の文字の１個下の行に入った数値の合計を、検索した時に入力した文字数と一緒に「計算結果」というシートに貼り付ける。
例：検索した名前が「たまねぎ」で、その名前がsheet1のＤ３にあったら４行目の可視セルに入った数値の合計と名前をシート「計算結果」に貼り付ける。

※sheet2のＤ７にも同名の「たまねぎ」があった場合、８行目の可視セルの合計を加算して、総計を返す。返す値はブック全体の名前検索結果の１つ下の行の可視セルの合計。

シート「計算結果」
Ａ１ Ｂ１
たまねぎ 合計(全シートのＤ列にたまねぎが入った行の、
１つ下の行の可視セルの合計)
貼り付けの際、Ａ１とＢ１に既に別の文字と数値が入っていた際は
次の空白の行Ａ２とＢ２に貼り付ける(空白のセルに貼り付ける)

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

• tom04様、マクロ構築ありがとうございます。
  説明不足で申し訳ありませんでした。
  各シートの表は画像のような感じになっておりまして、Ｋ列から数値が入っております。
  検索した文字列の１行下のＫ列からＢＴ列までの数値データの合計が
  計算結果に出るのが望ましいのですが、可能でしょうか。

  
  No.1の回答に寄せられた補足コメントです。 補足日時：2017/09/04 08:36

• 

  tom04様
  こんにちは、補足へのご返信ありがとうございます。
  確認の３つの項目の補足を送ります。
  
  ①ExcelのBook全体のＤ列をユーザーが入力した任意の文字で検索する。
  とありますが、画像ではJ列になっていますね？
  ＞申し訳ありません、画像ではＪ列になっておりますが、検索する列は「Ｄ」列です。
  
  ②画像のような配置のシートが複数ブック内に同じ配置で存在している。
  ＞はい、そうです。入っている情報は違いますが、表の配置は同じです。
  
  ③一般的に考えると、J列に同じ「品名」が複数存在するのは考えにくいのですが、質問文では複数存在する場合もある。と読み取れます。これで間違いないでしょうか？
  ＞お察しの通りです。Ｄ列に同じ「品名」が複数存在する場合もあります。
  
  分かりづらくて本当に申し訳ありません。
  お手数をおかけいたしますが、よろしくお願いいたします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2017/09/04 12:00

No.3 ベストアンサー 回答者： tom04 回答日時： 2017/09/04 15:46

続けてお邪魔します。

結局各シートのD列を検索し、D列に対象品名があればその1行下のK～BT列の数値を合計すれば良いのですね？
↓のコードにしてみてください。

Sub Sample2()
Dim k As Long, myRow As Long, myFlg As Boolean
Dim myStr As String, wS As Worksheet
Dim myRng As Range, myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> .Name Then
Set wS = Worksheets(k)
Set myFound = wS.Range("D:D").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
If Not myFound Is Nothing Then
.Cells(myRow, "A") = myStr
myFlg = True
Set myFirst = myFound
GoTo 処理
Do
Set myFound = wS.Range("D:D").FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
GoTo 処理
処理:
Set myRng = Range(wS.Cells(myFound.Row + 1, "K"), wS.Cells(myFound.Row + 1, "BT"))
With .Cells(myRow, "B")
.Value = .Value + WorksheetFunction.Sum(myRng)
End With
Loop
End If
End If
Next k
If myFlg = False Then
MsgBox "該当品目なし"
End If
End With
End Sub

今度はどうでしょうか？m(_ _)m

この回答へのお礼

おはようございます。
ご返信が遅くなってしまい、申し訳ありません。
幾つか品名を検索し、求めていた合計値が出ることが確認できました！
本当に助かりました、ありがとうございます。
作業効率が上がり、他の作業に手を回せるようになって嬉しい限りです！

お礼日時：2017/09/05 08:59

No.2 回答者： tom04 回答日時： 2017/09/04 11:44

No.1です。

回答ではありません、確認です。

質問文では
①　＞①ExcelのBook全体のＤ列をユーザーが入力した任意の文字で検索する。
とありますが、画像ではJ列になっていますね？
J列で間違いないのでしょうか？

②　画像のような配置のシートが複数ブック内に同じ配置で存在している。

③　一般的に考えると、J列に同じ「品名」が複数存在するのは考えにくいのですが、
質問文では複数存在する場合もある。と読み取れます。
これで間違いないでしょうか？

上記のコトが正確に判断できないと
ココでコードを載せても無意味になるようなので・・・m(_ _)m

No.1 回答者： tom04 回答日時： 2017/09/02 21:35

こんばんは！

＞検索結果の文字の１個下の行に入った数値の合計を・・・
というコトは↓の画像のように「品名」と「数量」がD列に交互にある！というコトでしょうか？

そういうコトだとしての一例です。
標準モジュールにしてください。

Sub Sample1()
Dim k As Long, wS As Worksheet
Dim myRow As Long, myStr As String
Dim myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(myRow, "A") = myStr
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> .Name Then
Set wS = Worksheets(k)
Set myFound = wS.Range("D:D").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
If Not myFound Is Nothing Then
Set myFirst = myFound
With .Cells(myRow, "B")
.Value = .Value + myFound.Offset(1)
End With
Do
Set myFound = wS.Range("D:D").FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
With .Cells(myRow, "B")
.Value = .Value + myFound.Offset(1)
End With
Loop
End If
End If
Next k
End With
End Sub

上記マクロを実行すると
画像の一番左側Sheetのような感じになります。m(_ _)m