OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

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

  • すぐに回答を!
  • 質問No.156257
  • 閲覧数44
  • ありがとう数0
  • 気になる数0
  • 回答数2
  • コメント数0

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

上記の2つのデータ表がありまして、上の表の部門コード&UHRSEMが下の表と同じであれば下の表の合計5.0の値を
上の表のUHRSEMの列に合計の値(5.0)を挿入するマクロの操作を教えて下さい。
通報する
  • 回答数2
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.2
レベル13

ベストアンサー率 68% (791/1163)

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

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

1.合計はマクロを使わなくても可能でしょう。
 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で配列数式とすれば計算できます。

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

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

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
-PR-
-PR-

その他の回答 (全1件)

  • 回答No.1
レベル7

ベストアンサー率 21% (3/14)

多少項目をカットしていますがこんな感じでどうでしょう For Index = 1 To 3 '上の表が3件なので3回ループします  atai = 0 '合計のエリアをクリア  FINDFLG = "0" '見つかったかどうか判定するフラグの初期化  cell = "A" & Index ...続きを読む
多少項目をカットしていますがこんな感じでどうでしょう
For Index = 1 To 3 '上の表が3件なので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 '下の表が3件なので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

このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ