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

部門コードUHRSEMSEMEDSS570SEMD-SEMTEMウルトラミクロトーム
CKY000　　　　
CY6B4Z　　　　
C27600 5.0
---------------------------------------------------------------------------------
UHRSEM　　　　　C27600U59092.0 30000
UHRSEM　　　　　C27600U59093.0 45000
バイブロン C27600 U59095.0 30000

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

No.2 ベストアンサー 回答者： nishi6 回答日時： 2001/10/24 14:43

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

上の表は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

No.1 回答者： toro010915 回答日時： 2001/10/23 21:44

多少項目をカットしていますがこんな感じでどうでしょう

For Index = 1 To 3 '上の表が３件なので３回ループします
　atai = 0 '合計のエリアをクリア
　FINDFLG = "0" '見つかったかどうか判定するフラグの初期化
　cell = "A" & Index '上の表の部門コードのセル　
　a = Range(cell).Value ’上の表の部門の値
　cell2 = "B" & Index
　b = Range(cell2).Value '上の表のuhrsemの値
　For index2 = 1 To 3　'下の表が３件なので３回ループします
　　cell3 = "E" & index2　
　　c = Range(cell3).Value’下の表の部門の値
　　cell4 = "F" & index2
　　d = Range(cell4).Value’下の表のuhrsemの値
　　If a = c And b = d Then '同じかどうか比較
　　cell5 = "G" & index2 '値の入っているセルの値
　　atai = atai + Range(cell5).Value '合計足しこみ
　　If FINDFLG = "0" Then
　　 FINDFLG = "1"　'見つかったためフラグをセット
　　End If
　　End If
　Next index2
　If FINDFLG = "1" Then
　 cell6 = "C" & Index
　Range(cell6).Value = atai '見つかったため値をセット
　End If
Next Index