エクセル２０００マクロ操作について

質問

部門コード UHRSEM SEMEDS S570SEM D-SEM TEM ウルトラミクロトーム
CKY000 　　　　
CY6B4Z 　　　　
C27600 5.0
---------------------------------------------------------------------------------
UHRSEM 　　　　　C27600 U5909 2.0 30000
UHRSEM 　　　　　C27600 U5909 3.0 45000
バイブロン C27600 U5909 5.0 30000

上記の２つのデータ表がありまして、上の表の部門コード＆UHRSEMが下の表と同じであれば下の表の合計5.0の値を
上の表のUHRSEMの列に合計の値(5.0）を挿入するマクロの操作を教えて下さい。

回答No.2

nishi6 · ベストアンサー

質問の主旨は、合計表を作成するマクロですよね。

上の表はSheet1のA1から、下の表はSheet2のA1から(表題無し)作成されているとします。

１．合計はマクロを使わなくても可能でしょう。
　B4セルに
　　=SUM(IF(Sheet2!$A$1:$A$3=B$1,IF(Sheet2!$B$1:$B$3=$A4,Sheet2!$D$1:$D$3,0)))
　として、Ctrl+Shift+Enterで配列数式とすれば計算できます。

２．ピボットテーブルでも簡単にできます。

３．マクロで行うと、以下のようなコードになりました。
標準モジュールに貼り付けます。(合計表の項目数、データ数は自動計算しています)
ご参考に。

Public Sub Syukei()
　　Dim wsTTL As Worksheet '集計表のあるシート
　　Dim wsDat As Worksheet 'データのあるシート
　　　　Set wsTTL = Worksheets("Sheet1")
　　　　Set wsDat = Worksheets("Sheet2")
　　Dim rw As Long '集計表の行
　　Dim col As Integer '集計表の列
　　Dim TTL As Double '合計値
　　Dim dataNum As Long 'データ数
　　Dim rwDt As Long 'データの行カウンタ
　　'データ数を求める
　　dataNum = wsDat.Range("A1").End(xlDown).Row
　　Range("A1").Select
　　'各合計値を求める
　　For rw = 2 To wsTTL.Range("A2").End(xlDown).Row
　　　　For col = 2 To wsTTL.Range("B1").End(xlToRight).Column
　　　　　　TTL = 0
　　　　　　With wsDat
　　　　　　　　For rwDt = 1 To dataNum
　　　　　　　　　　If wsTTL.Cells(rw, 1) = .Cells(rwDt, 2) Then
　　　　　　　　　　　　If wsTTL.Cells(1, col) = .Cells(rwDt, 1) Then
　　　　　　　　　　　　　　TTL = TTL + .Cells(rwDt, 4)
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　　　wsTTL.Cells(rw, col) = TTL '集計表に書き込み
　　　　　　End With
　　　　Next
　　Next
End Sub