Excel VBA質問箱 IV

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

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


41059 / 76732 ←次へ | 前へ→

【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
>製造番号 4月   5月  6月   7月   8月 9月 10月 11月・・・
>11    28000  27000  25000
>22        29000  26000  24000
>33
>44
>55

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

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

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

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
0 hits

【40743】検索にかけ転記したいのですが。 toy 06/7/22(土) 1:11 質問
【40756】Re:検索にかけ転記したいのですが。 ナイスプログラム 06/7/23(日) 2:20 回答
【40769】Re:検索にかけ転記したいのですが。 toy 06/7/23(日) 16:44 発言
【40771】Re:検索にかけ転記したいのですが。 ナイスプログラム 06/7/23(日) 19:49 回答
【40773】Re:検索にかけ転記したいのですが。 ナイスプログラム 06/7/23(日) 21:27 回答
【40824】Re:検索にかけ転記したいのですが。 toy 06/7/24(月) 19:56 お礼
【40757】Re:検索にかけ転記したいのですが。 kobasan 06/7/23(日) 9:13 発言

41059 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free