指定した項目を合計したいのですが・・・

質問

マクロで指定した項目を合計したいのですが・・・・
機番　　項目A　項目B　項目C　項目D　項目E　合計
１　　　　　０　　　　１　　　　０　　　　３　　　　２
２　　　　　１　　　　３　　　　２　　　　０　　　　１
３　　　　　２　　　　０　　　　１　　　　４　　　　１
・・・
項目AとCとEの合計をしたいのですが、いつもAがあるとは限りません。
ですから、同じ列に同じ項目があるとも限りません。
このような状況で各機番に対する項目AとCとEをマクロで合計させるには
どのようにすれば良いのでしょうか？また、機械も何台あるかはその日集計によって異なります。以上、よろしくお願いします。

回答No.3

yone_sk · ベストアンサー

まず
　Set obj = Cells.Find(TITLE_A)
の後に
　Set obj = Cells.Find(TITLE_E)
をやると、最初のobjを上書きしてしまっているので、項目Aの有無がわからなくなってしまいます。
ですので、objを
　Dim objA As Object
　Dim objE As Object
の二つに分けます。
それと、足し算のところチョット修正しましたネ。
見てもらえばわかると思います＾＾

それと、
　Const TOTAL_COL As Integer = 7
ここに合計の列番号を入れてください。
------------------------------------------
Const TITLE_A As String = "A"
Const TITLE_C As String = "C"
Const TITLE_E As String = "E"
Const TOTAL_COL As Integer = 7

Dim i As Integer
Dim j As Integer
Dim rngA As Range
Dim rngC As Range
Dim rngE As Range
Dim objA As Object
Dim objE As Object

Set objA = Cells.Find(TITLE_A)
If Not objA Is Nothing Then
Set rngA = Range(Cells(1, Cells.Find(TITLE_A).Column), Cells(1, Cells.Find(TITLE_A).Column))
End If

Set rngC = Range(Cells(1, Cells.Find(TITLE_C).Column), Cells(1, Cells.Find(TITLE_C).Column))

Set objE = Cells.Find(TITLE_E)
If Not objE Is Nothing Then
Set rngE = Range(Cells(1, Cells.Find(TITLE_E).Column), Cells(1, Cells.Find(TITLE_E).Column))
End If

i = 2
While (Cells(i, 1) <> "")
Cells(i, TOTAL_COL) = 0
If Not objA Is Nothing Then
Set rngA = rngA.Offset(1, 0)
Cells(i, TOTAL_COL) = Cells(i, TOTAL_COL) + rngA.Value
End If

Set rngC = rngC.Offset(1, 0)
Cells(i, TOTAL_COL) = Cells(i, TOTAL_COL) + rngC.Value

If Not objE Is Nothing Then
Set rngE = rngE.Offset(1, 0)
Cells(i, TOTAL_COL) = Cells(i, TOTAL_COL) + rngE.Value
End If

i = i + 1
Wend

Set rngA = Nothing
Set rngC = Nothing
Set rngE = Nothing
Set objA = Nothing
Set objE = Nothing
------------------------------------------
ホントはもっときれいに書きたいんだけど ＾＾；

お礼

その項目があれば、その都度加えていけば良いのですか。
勉強になりました。ありがとうございます。

回答No.2

yone_sk

> ここでは項目Aが、無かった場合ですが、項目Eが無い時もあります。

rngA をif分で括っているところはわかりますでしょうか？
それと同じようにrngEも括ってあげればできますよ＾＾

その際にobjを使用していますが、これをobjA、objEと二つ用意してあげればできますよね。

わからないところがあれば、言ってくださいな＾＾

お礼

ご回答して頂き、本当にありがとうございます。
objEを付けましたが・・・
Const TITLE_A As String = "A"
Const TITLE_C As String = "B"
Const TITLE_E As String = "C"

Dim i As Integer
Dim j As Integer
Dim rngA As Range
Dim rngC As Range
Dim rngE As Range
Dim obj As Object

Set obj = Cells.Find(TITLE_A)
If Not obj Is Nothing Then
Set rngA = Range(Cells(1, Cells.Find(TITLE_A).Column), Cells(1, Cells.Find(TITLE_A).Column))
End If

Set rngC = Range(Cells(1, Cells.Find(TITLE_C).Column), Cells(1, Cells.Find(TITLE_C).Column))

Set obj = Cells.Find(TITLE_E)
If Not obj Is Nothing Then
Set rngE = Range(Cells(1, Cells.Find(TITLE_E).Column), Cells(1, Cells.Find(TITLE_E).Column))
End If

i = 2
While (Cells(i, 1) <> "")
Cells(i, 19) = 0
If Not obj Is Nothing Then
Set rngA = rngA.Offset(1, 0)
Cells(i, 19) = rngA.Value
End If

If Not obj Is Nothing Then
Set rngE = rngE.Offset(1, 0)
Cells(i, 19) = rngE.Value
End If

Cells(i, 19) = Cells(i, 19) + rngC.Offset(1, 0).Value + rngE.Offset(1, 0).Value
Set rngC = rngC.Offset(1, 0)

i = i + 1
Wend

Set rngA = Nothing
Set rngC = Nothing
Set rngE = Nothing

End Sub
----------------------------
項目Eがない場合に上手く動作しません。
+ rngE.Offset(1, 0).Value　のところがいけないようです。
申し訳ありません。ご教授願います。
以上、よろしくお願いします。

回答No.1

yone_sk

こんな感じでしょうか？
出力先をG列固定にしちゃってるので、その辺はいじってください＾＾；
------------------------------
Private Sub CommandButton1_Click()
Const TITLE_A As String = "項目A"
Const TITLE_C As String = "項目C"
Const TITLE_E As String = "項目E"

Dim i As Integer
Dim j As Integer
Dim rngA As Range
Dim rngC As Range
Dim rngE As Range
Dim obj As Object

Set obj = Cells.Find(TITLE_A)
If Not obj Is Nothing Then
Set rngA = Range(Cells(1, Cells.Find(TITLE_A).Column), Cells(1, Cells.Find(TITLE_A).Column))
End If
Set rngC = Range(Cells(1, Cells.Find(TITLE_C).Column), Cells(1, Cells.Find(TITLE_C).Column))
Set rngE = Range(Cells(1, Cells.Find(TITLE_E).Column), Cells(1, Cells.Find(TITLE_E).Column))

i = 2
While (Cells(i, 1) <> "")
Cells(i, 7) = 0
If Not obj Is Nothing Then
Set rngA = rngA.Offset(1, 0)
Cells(i, 7) = rngA.Value
End If
Cells(i, 7) = Cells(i, 7) + rngC.Offset(1, 0).Value + rngE.Offset(1, 0).Value
Set rngC = rngC.Offset(1, 0)
Set rngE = rngE.Offset(1, 0)
i = i + 1
Wend

Set rngA = Nothing
Set rngC = Nothing
Set rngE = Nothing
End Sub
------------------------------

お礼

大変参考になりました。
ありがとうございます。

補足

すみません。
ここでは項目Aが、無かった場合ですが、項目Eが無い時もあります。
その場合はどうすればいいでしょうか？
以上、よろしくお願いします。