別シートに分類毎にまとめ合計を算出

質問

シート１の表－１に会社名、区分No.、作業班ごとに工数、金額が入力されておりシート２の表－２に会社別に工数、金額の合計を算出したい、区分、作業班が同じであれば１行に工数、金額を加算し違えば次行区分、作業班が追加され会社毎の合計を出したいのですが表－２の会社名は見やすくセル結合をしていますがセル範囲が一定とならないためそれぞれの行に会社名が入っても構いません。どなたかVBAコードが解る方宜しくお願いします。

回答No.1

Prome_Lin · ベストアンサー

まず、この質問になかなか、回答がつかない理由は、「Visual Basic」で質問しているからです。

もう一度、同じ内容で、「エクセル」で質問すれば、回答がすぐにつくと思います。

次に、私なりの回答ですが、前提条件から、

「シート１」（「一番左端のシート」、という意味で、名前そのものには意味はありません。どのような名前でも結構です。）の
「A1」＝「表１」
２行目は、項目名で、
「A2」＝「会社名」、「B2」＝「区分」、「C3」＝「作業班」、「D3」＝「工数」、「E3」＝「金額」
「A4」以降にそれぞれのデータが入っているものとします。

「シート２」（「左端から２番目のシート」、という意味。同上）の
「A1」＝「表２」
２行目は、項目名で、「シート１」と全く同じです。

という、前提条件の下で、以下のマクロを走らせると、結果が出ているはずです。
（サンプルデータを作り、実際に試しています。）

Option Explicit
Sub Test()
Dim a As String
Dim n(), c, i, r As Integer
Dim k, t As Long
Dim s1, s2 As Worksheet
Set s1 = Worksheets(1)
Set s2 = Worksheets(2)
r = s1.Range("A3").End(xlDown).Row
s1.Range(s1.Cells(3, 1), s1.Cells(r, 5)).Copy s2.Range("A3")
s2.Range(s2.Cells(3, 1), s2.Cells(r, 5)).Sort Key1:=s2.Range("A3"), Order1:=xlAscending
a = s2.Range("A3").Value
c = 3
k = s2.Cells(c, 4).Value
t = s2.Cells(c, 5).Value
Do
c = c + 1
If a = s2.Cells(c, 1).Value Then
k = k + s2.Cells(c, 4).Value
t = t + s2.Cells(c, 5).Value
ElseIf a <> s2.Cells(c, 1).Value Then
s2.Rows(c).Insert
s2.Cells(c, 4).Value = k
s2.Cells(c, 5).Value = t
c = c + 1
a = s2.Cells(c, 1).Value
k = s2.Cells(c, 4).Value
t = s2.Cells(c, 5).Value
End If
Loop Until s2.Cells(c, 1).Value = ""
End Sub

簡単なプログラムの説明です。

「r = s1.Range("A3").End(xlDown).Row」は「シート１」の「Ａ」列の最終行が、何行目なのかを取得しています（この場合、途中に空白のセルがあってはいけません）。

「s1.Range(s1.Cells(3, 1), s1.Cells(r, 5)).Copy s2.Range("A3")」
「シート１」のデータのある範囲をコピー（記憶）して、「シート２」の「A3」セルを基点にペースト（貼り付け）しています。

「s2.Range(s2.Cells(3, 1), s2.Cells(r, 5)).Sort Key1:=s2.Range("A3"), Order1:=xlAscending」
今、貼り付けた内容を、「A」列をキーとして、ソートしています（これで、同じ会社が集まります）。

あとは、まず、「A3」セルの「会社名」を読み込み、次から次へと行を調べ、同じ「会社名」だった場合は、「工数」と「金額」を足していきます。

「会社名」がそれまでと変わった場合、１行挿入して、そこに、それまでの「工数」と「金額」の合計を出力。

と、このような処理を繰り返しています。

最後の判断は、「会社名」を読み込んでみて、セルの値が空白だった場合、すべての処理を終了しています。

回答No.2

Prome_Lin

回答No.1です。

すみません、試行錯誤の段階で「Dim n()」とやっていたのですが、最終プログラムでは不要でした。

４行目の「n(),」は削除しておいてください。

申し訳ありません。