| 
    
     |  | ▼まこっちゃん さん: 
 >現在、シートが100位あって、各シートには合計はなく、商品もランダムに記載されてます。
 >B列には数値化された商品名、C列には数量が下記のように記載されています
 
 >また1行目からデータが記載してあり行数は最大で5000行です
 
 一般機能に その名も「統合」という機能がありますから、これを
 使ってみてはいかがでしょう。
 
 たとえば、対象Bookに 統合用シートを追加し
 シート名をたとえば「統合」としておいて、
 「Sheet1」と「Sheet2」に 提示のような元表があるとして、この
 2枚のシートを メニュ−[データ]-[統合...]
 から統合する操作のマクロ記録をとってみると、以下のようになります。
 
 Option Explicit
 
 Sub Macro1()
 ' マクロ記録日 : 2009-10-11 ユーザー名 : kanabun
 '
 Sheets("統合").Activate
 Range("A1").Select
 Selection.Consolidate Sources:=Array("[Book1]Sheet1!R1C2:R6C3", _
 "[Book1]Sheet2!R1C2:R6C3"), Function:=xlSum, TopRow:=False, LeftColumn:= _
 True, CreateLinks:=False
 End Sub
 'これはマクロ記録にあるとおり、統合先の先頭セルをアクティブにしておいて、
 統合元範囲のリストに 各シートのB,C列範囲を設定し、
 >また1行目からデータが記載してあり
 ということなので、【統合の基準】CheckBoxの「上端行(T)」のチェックを外し
 て、集計の方法「合計」で 統合をかけたことを表しています。
 
 > シートが100位あって、
 ということなので、手操作で 100回も各シートの範囲を指定するのは大変なので、
 上のマクロ記録を もすこし汎用的に使えるように修正します。
 ポイントは対象Bookの「統合」シートを除くすべてのシートをループして
 データ範囲のアドレス(xlR1C1形式)を配列に格納していることです。
 実際に統合する部分は Array... の部分を この配列変数に替えるだけで、
 マクロ記録がそのまま使えます。
 
 >  For Each ws In ActiveWorkbook.Worksheets
 >    If Not ws Is wsT Then  'ws が 「統合」シートでなかったら
 >      '範囲アドレスを配列に追加する
 
 Sub Try1_統合()
 Dim ws As Worksheet
 Dim wsT As Worksheet
 Dim Ranges() As String, n As Long
 Set wsT = ActiveWorkbook.Worksheets("統合")
 For Each ws In ActiveWorkbook.Worksheets
 If Not ws Is wsT Then
 n = n + 1
 ReDim Preserve Ranges(1 To n)
 With ws
 Ranges(n) = .Range("B1", .Cells(.Rows.Count, 3).End(xlUp)) _
 .Address(, , xlR1C1, True)
 End With
 End If
 Next
 With wsT
 .UsedRange.ClearContents
 .Range("A1").Consolidate Sources:=Ranges, Function:=xlSum, _
 TopRow:=False, LeftColumn:=True
 End With
 End Sub
 
 ただ、100枚ものシートに統合をかけるとなると一呼吸かかるかもしれません。
 そういう場合は Dictionaryオブジェクトというものを利用して、
 端からVBAでやると高速処理できるでしょう。
 
 |  |