Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

41134 / 76807

←次へ　｜　前へ→


	【40757】Re:検索にかけ転記したいのですが。

kobasan - 06/7/23(日) 9:13 -


	引用なし

	パスワード

おはようございます。

Sheet1
> A　　　　　　　 B　　　　C　　　 D　　　　 E　　F・・・・　M
>製造番号11　　　4 月　　　5 月　　6 月　　　　　　　　　　　
>東京本店　　　 15000　　12000　　 13000
>大阪支店　　　 13000　　15000　　12000

Sheet2
> A　　　　　　　 B　　　　C　　　 D　　　　 E　　F・・・・M
>製造番号22　　　5 月　　　6 月　　7月　　　　　　　　　　　　　
>東京本店　　　 15000　　11000　　 13000
>大阪支店　　　 14000　　15000　　11000

Sheet1とSheet2の合計を転記
Sheet3
>　 A　　　 B　　　　C　　　 D　　　E　　　　F　　 G　　 H　　　I
>製造番号　４月　　５月　　６月　　　７月　　８月　９月　１０月　１１月・・・
>11　　　 28000　　27000　 25000
>22　　　　　　　　29000　 26000　　24000
>33
>44
>55

まずは、上記のように、同じブック内で、Sheet3の形を作ってみてはどうでしょうか。
これがでたら、Wprkbooks.Openを利用して、ブック間操作をすればできます。

参考までに、各シートの下に合計を求めるサンプルを作っておきました。
これから先は、いろいろ試してみて、作ってください。

ただし、
A1セルに製造番号○○と必ず入れておいてください。
製造番号11　　　4 月　　　5 月　　6 月　
の項目行は１行目とします。

Sub test()
Dim nmb As String
Dim s As Worksheet
Dim vntM, myArray(1 To 13)
Dim r As Range, rng As Range
Dim LastRow As Long, clmn As Long
　　'
　　vntM = Array("製造番号", "4月", "5月", "6月", "7月", "8月", _
　　　　　 "9月", "10月", "11月", "12月", "1月", "2月", "3月")
　　'
　　For Each s In ThisWorkbook.Worksheets
　　　　nmb = s.Cells(1, 1).Text
　　　　If Left(nmb, 4) = "製造番号" Then
　　　　　　LastRow = s.Cells(65536, 1).End(xlUp).Row
　　　　　　For Each r In s.Range("B1:M1")
　　　　　　　　For clmn = 1 To UBound(vntM)
　　　　　　　　　　If vntM(clmn) = r.Text Then Exit For
　　　　　　　　Next
　　　　　　　　'
　　　　　　　　Set rng = r.Offset(1).Resize(LastRow - 1, 1)
　　　　　　　　myArray(clmn + 1) = Application.Sum(rng)
　　　　　　Next
　　　　　　s.Activate
　　　　　　s.Cells(LastRow + 2, 1).Resize(2, UBound(myArray)).Value = _
　　　　　　Application.Transpose(Application.Transpose(Array(vntM, myArray)))
　　　　End If
　　Next
　　'
　　Set rng = Nothing
　　Erase vntM: Erase myArray
End Sub

2 hits

▼

【40743】検索にかけ転記したいのですが。 toy 06/7/22(土) 1:11