Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2321 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【68707】煩雑なデータ処理の解消方法は？？ マエ/ケン 11/4/9(土) 12:24 質問[未読]
【68710】Re:煩雑なデータ処理の解消方法は？？ UO3 11/4/9(土) 13:15 回答[未読]
【68716】Re:煩雑なデータ処理の解消方法は？？ マエ/ケン 11/4/9(土) 18:16 質問[未読]
【68718】Re:煩雑なデータ処理の解消方法は？？ UO3 11/4/9(土) 19:10 回答[未読]
【68719】Re:煩雑なデータ処理の解消方法は？？ マエ/ケン 11/4/9(土) 20:34 質問[未読]
【68720】Re:煩雑なデータ処理の解消方法は？？ UO3 11/4/9(土) 21:50 発言[未読]
【68721】Re:煩雑なデータ処理の解消方法は？？ UO3 11/4/10(日) 0:38 回答[未読]
【68725】Re:煩雑なデータ処理の解消方法は？？ マエ/ケン 11/4/10(日) 20:24 質問[未読]
【68726】Re:煩雑なデータ処理の解消方法は？？ UO3 11/4/10(日) 21:00 発言[未読]
【68730】Re:煩雑なデータ処理の解消方法は？？ マエ/ケン 11/4/11(月) 11:26 質問[未読]
【68731】Re:煩雑なデータ処理の解消方法は？？ UO3 11/4/11(月) 12:08 回答[未読]
【68727】Re:煩雑なデータ処理の解消方法は？？ UO3 11/4/10(日) 21:02 発言[未読]
【68744】Re:煩雑なデータ処理の解消方法は？？ マエ/ケン 11/4/13(水) 15:17 お礼[未読]
【68711】Re:煩雑なデータ処理の解消方法は？？ だるま 11/4/9(土) 14:27 回答[未読]
【68717】Re:煩雑なデータ処理の解消方法は？？ マエ/ケン 11/4/9(土) 18:24 質問[未読]
【68722】Re:煩雑なデータ処理の解消方法は？？ kanabun 11/4/10(日) 6:41 発言[未読]
【68707】煩雑なデータ処理の解消方法は？？
質問  マエ/ケン  - 11/4/9(土) 12:24 -
引用なし
パスワード
   お世話になります。

以下のExcelデータを使って、
　行合計＝Price×GroupTotal（Sheet1の５行目から最終行まで）
　列合計＝ΣPrice×Group01 （Sheet1の５行目から最終行まで）
　　　　　・
　　　　　GroupTotalの前列まで
　毎日、計算式を埋め込んで、結構手間。。。
　何かいい方法あるのでしょうか？ぜひご伝授ください。
　
ItemNo.　ItemName　Price　・Unit　Group01　Group02　・GroupTotal
A001　　ア００１　100　　　ｸﾞﾗﾑ　　10　　　 20　　　　　　 30
A002　　イ００１　200　　　ｸﾞﾗﾑ　　30　　　 40　　　　　　 70
・
・

計算方法：Unit列の次列からGroupTotal列の前列までのそれぞれの列の
　　　　　掛け算を算出したいです。
　　　　　　
計算結果のイメージ

ItemNo.　ItemName　Price　・Unit　Group01　Group02　・GroupTotal　Total
A001　　ア００１　10 　　　ｸﾞﾗﾑ　　10　　　 20　　　　 30　　　　　300
A002　　イ００１　20　 　　ｸﾞﾗﾑ　　30　　　 40　　　　 70　　　　　1,400
・
・
合計　　　　　　　　　　　　　　 700　　　1,000　　　1,700
【68710】Re:煩雑なデータ処理の解消方法は？？
回答  UO3  - 11/4/9(土) 13:15 -
引用なし
パスワード
   ▼マエ/ケン さん：

シートレイアウトで誤解しているところがあるかもしれませんが一例です。


Sub Sample()
　　Dim v As Variant
　　Dim w() As Long
　　Dim wk1 As Long, wk2 As Long
　　Dim tot1 As Long, tot2 As Long
　　Dim i As Long, x As Long
　　
　　With Sheets("Sheet1")　'<== 実際のシート名に
　　　　x = .Range("A" & .Rows.Count).End(xlUp).Row
　　　　v = .Range("A5").Resize(x - 4, 7).Value
　　　　ReDim w(LBound(v, 1) To UBound(v, 1))
　　　　For i = LBound(v, 1) To UBound(v, 1)
　　　　　　wk1 = v(i, 3) * v(i, 5)
　　　　　　wk2 = v(i, 3) * v(i, 6)
　　　　　　w(i) = wk1 + wk2
　　　　　　tot1 = tot1 + wk1
　　　　　　tot2 = tot2 + wk2
　　　　Next
　　　　.Range("H4").Value = "Total"
　　　　.Cells(x + 1, 1).Value = "合計"
　　　　.Cells(x + 1, 5).Value = tot1
　　　　.Cells(x + 1, 6).Value = tot2
　　　　.Range("H5").Resize(UBound(w)).Value = WorksheetFunction.Transpose(w)
　　End With
　　
End Sub
【68711】Re:煩雑なデータ処理の解消方法は？？
回答  だるま  - 11/4/9(土) 14:27 -
引用なし
パスワード
   こんにちは

いまいち分かっていないかもしれませんが、毎日行方向にデータが増えて行き
最終行の下の合計行の数式を書き換えなければならないので大変、ということ
でしょうか。

もしそうなら、データの最終行と合計行の間に一行空行を空けて、合計行の
数式をその空行まで含むようにしておき、データの追加はその空行へ行挿入
するようにすれば数式は自動で拡張されます。

例えばこんな数式
=SUMPRODUCT($C5:$C9,$E5:$E9)

この場合、現在のデータは5行目から8行目まで、次にデータを追加する時は
9行目に行挿入します。そうすれば数式の中の「9」は自動的に「10」に拡張
されます。^d^
【68716】Re:煩雑なデータ処理の解消方法は？？
質問  マエ/ケン  - 11/4/9(土) 18:16 -
引用なし
パスワード
   UO3 さん

　ありがとうございます。説明不足でごめんなさい。。

・計算前
ItemNo.　ItemName　Price　Unit　Group01　Group02　・GroupTotal
｜←-------列数不変-------→｜　←---列数可変---→｜　
　　　　　　　　　　

・計算後　　　　　　　　　　　　　　　　　　　　　　　　　　　　↓追加分
ItemNo.　ItemName　Price　Unit　Group01　Group02　・GroupTotal　Total　
｜←-------列数不変-------→｜←-----列数可変----→｜

▲縦計の計算
Group01縦列の合計＝C2×E2+C3×E3+・・・・C最終×E最終
Group02縦列の合計＝C2×F2+C3×F3+・・・・C最終×F最終
・
・
・
GroupTotal前縦列の合計＝C2×GroupTotal前縦列2+C3×GroupTotal前縦列3+
　　　　　　　　　　　　C最終×GroupTotal前縦列最終

▲横計の計算Total
GroupTotalの後列=C2×GroupTotal列2+C3×GroupTotal列3+・・・・+
　　　　　　　　 C2×GroupTotal列最終
【68717】Re:煩雑なデータ処理の解消方法は？？
質問  マエ/ケン  - 11/4/9(土) 18:24 -
引用なし
パスワード
   だるまさん

こんにちは、分かりづらい説明で、すみません。

　日々データの変化は、Unit列は固定ですが、Group01より列の増減があり、
また縦方向の増減もあります。
【68718】Re:煩雑なデータ処理の解消方法は？？
回答  UO3  - 11/4/9(土) 19:10 -
引用なし
パスワード
   ▼マエ/ケン さん：

基本的には２列固定のアップ済みのコードを列数変数化することになります。
その結果、ちょっとゴチャゴチャしますが。

Sub Sample2()
　　Dim v As Variant
　　Dim w() As Long
　　Dim gCnt As Long　'グループ数
　　Dim vTot() As Long
　　Dim vWk() As Long
　　Dim i As Long, x As Long, z As Long
　　
　　With Sheets("Sheet1")　 '<==実際のシート名に
　　　　x = .Cells(4, .Columns.Count).End(xlToLeft).Column
　　　　gCnt = x - 4 - 1
　　　　ReDim vTot(1 To gCnt)
　　　　ReDim vWk(1 To gCnt)
　　　　x = .Range("A" & .Rows.Count).End(xlUp).Row
　　　　v = .Range("A5").Resize(x - 4, x).Value
　　　　ReDim w(LBound(v, 1) To UBound(v, 1))
　　　　For i = LBound(v, 1) To UBound(v, 1)
　　　　　　For z = 1 To gCnt
　　　　　　　　vWk(z) = v(i, 3) * v(i, z + 4)
　　　　　　　　w(i) = w(i) + vWk(z)
　　　　　　　　vTot(z) = vTot(z) + vWk(z)
　　　　　　Next
　　　　Next
　　　　.Cells(4, x + 1).Value = "Total"
　　　　.Cells(x + 1, 1).Value = "合計"
　　　　For i = 1 To gCnt
　　　　　　.Cells(x + 1, i + 4).Value = vTot(i)
　　　　Next
　　　　.Cells(5, x + 1).Resize(UBound(w)).Value = WorksheetFunction.Transpose(w)
　　End With
　　　　
End Sub
【68719】Re:煩雑なデータ処理の解消方法は？？
質問  マエ/ケン  - 11/4/9(土) 20:34 -
引用なし
パスワード
   何かうまくいかないようで、(汗)
使っているデータはA4〜Ｏ17、
　　　メッセージ内容→「インデックスが有効範囲にはありません。」


ItemNo.　　　　ItemName　　　　Price　　　　Unit　　　　Group01　　　　Group02　　　　Group03　　　　Group04　　　　Group05　　　　Group06　　　　Group07　　　　Group08　　　　Group09　　　　Group10　　　　GroupTotal
AA001　　　　ああ001　　　　1　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA002　　　　ああ002　　　　2　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA003　　　　ああ003　　　　3　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA004　　　　ああ004　　　　4　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA005　　　　ああ005　　　　5　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA006　　　　ああ006　　　　6　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA007　　　　ああ007　　　　7　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA008　　　　ああ008　　　　8　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA009　　　　ああ009　　　　9　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA010　　　　ああ010　　　　10　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA011　　　　ああ011　　　　11　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA012　　　　ああ012　　　　12　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
AA013　　　　ああ013　　　　13　　　　ｸﾞﾗﾑ　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　1　　　　10
【68720】Re:煩雑なデータ処理の解消方法は？？
発言  UO3  - 11/4/9(土) 21:50 -
引用なし
パスワード
   ▼マエ/ケン さん：
>何かうまくいかないようで、(汗)
>使っているデータはA4〜Ｏ17、
>　　　メッセージ内容→「インデックスが有効範囲にはありません。」

このメッセージが出たときに黄色く光っていたコードはどこでしたか？
【68721】Re:煩雑なデータ処理の解消方法は？？
回答  UO3  - 11/4/10(日) 0:38 -
引用なし
パスワード
   ▼マエ/ケン さん：

わかりました。
こちらではエラーはでないのですが、いずれにしてもバグです。
（追加した変数を間違って書き換えているところがありました）

バグフィックス版（だといいのですが）です。

Sub Sample3()
　　Dim v As Variant
　　Dim w() As Long
　　Dim gCnt As Long　'グループ数
　　Dim vTot() As Long
　　Dim vWk() As Long
　　Dim i As Long, x As Long, y As Long, z As Long
　
　　With Sheets("Sheet1")　 '<==実際のシート名に
　　　　x = .Cells(4, .Columns.Count).End(xlToLeft).Column
　　　　gCnt = x - 4 - 1
　　　　ReDim vTot(1 To gCnt)
　　　　ReDim vWk(1 To gCnt)
　　　　y = .Range("A" & .Rows.Count).End(xlUp).Row
　　　　v = .Range("A5").Resize(y - 4, x).Value
　　　　ReDim w(LBound(v, 1) To UBound(v, 1))
　　　　For i = LBound(v, 1) To UBound(v, 1)
　　　　　　For z = 1 To gCnt
　　　　　　　　vWk(z) = v(i, 3) * v(i, z + 4)
　　　　　　　　w(i) = w(i) + vWk(z)
　　　　　　　　vTot(z) = vTot(z) + vWk(z)
　　　　　　Next
　　　　Next
　　　　.Cells(4, x + 1).Value = "Total"
　　　　.Cells(y + 1, 1).Value = "合計"
　　　　For i = 1 To gCnt
　　　　　　.Cells(y + 1, i + 4).Value = vTot(i)
　　　　Next
　　　　.Cells(5, x + 1).Resize(UBound(w)).Value = WorksheetFunction.Transpose(w)
　　End With
　　
End Sub
【68722】Re:煩雑なデータ処理の解消方法は？？
発言  kanabun  - 11/4/10(日) 6:41 -
引用なし
パスワード
   ▼マエ/ケン さん：

>　行合計＝Price×GroupTotal（Sheet1の５行目から最終行まで）
>　列合計＝ΣPrice×Group01 （Sheet1の５行目から最終行まで）

こんなふうにしても数式セットできると思います。

Sub Try1()
　　Dim m&, n&
　　Dim c As Range
　　Dim r As Range
　　m = Application.Match("GroupTotal", Rows(4), 0)
　　If IsError(m) Then Exit Sub
　　m = m - 4
　　Set c = Range("C5", Range("C4").End(xlDown))
　　n = c.Count
　　Set r = Range("E5").Resize(n, m)　'[E5]セルを基点に n行×m列の範囲
　　r.Columns(m + 1).FormulaR1C1 = "=RC[-" & m + 2 & "]*RC[-1]"
　　r.Rows(n + 1).Formula = "=Sumproduct(" & c.Address(1, 1, xlA1) _
　　　　　　　　　　& "," & c.Offset(, 2).Address(0, 0, xlA1) & ")"
End Sub
【68725】Re:煩雑なデータ処理の解消方法は？？
質問  マエ/ケン  - 11/4/10(日) 20:24 -
引用なし
パスワード
   UO3さん

　正確に動きましたよ！

ただ、再度実行すると、前の実行結果（追加された最終行次の「合計」や、「Total」のデータ）があるから、計算結果がおかしくなります。
毎回計算前に
　まず「合計」行や、「Total」列があれば、削除して、計算する。
　　　　なければ、計算する。
【68726】Re:煩雑なデータ処理の解消方法は？？
発言  UO3  - 11/4/10(日) 21:00 -
引用なし
パスワード
   ▼マエ/ケン さん：

>再度実行すると、前の実行結果（追加された最終行次の「合計」や、「Total」のデータ）があるから、計算結果がおかしくなります。
>毎回計算前に
>　まず「合計」行や、「Total」列があれば、削除して、計算する。
>　　　　なければ、計算する。


そのとおりですね。
なので、最初に最終行、あるいは右端列のタイトルをチェックして合計行であれば
削除してから処理をはじめるようなコードを追加されればよろしいでしょうね。
【68727】Re:煩雑なデータ処理の解消方法は？？
発言  UO3  - 11/4/10(日) 21:02 -
引用なし
パスワード
   ▼マエ/ケン さん：

↑

削除ではなくクリアのほうが処理コストの面でも、よろしいかも。
【68730】Re:煩雑なデータ処理の解消方法は？？
質問  マエ/ケン  - 11/4/11(月) 11:26 -
引用なし
パスワード
   >
>そのとおりですね。
>なので、最初に最終行、あるいは右端列のタイトルをチェックして合計行であれば
>削除してから処理をはじめるようなコードを追加されればよろしいでしょうね。

難しいようで、可能でしょうか？
【68731】Re:煩雑なデータ処理の解消方法は？？
回答  UO3  - 11/4/11(月) 12:08 -
引用なし
パスワード
   ▼マエ/ケン さん：

>難しいようで、可能でしょうか？

いえいえ、Sample3にちょっとだけ追加。
これで、合計があってもなくてもＯＫです。

Sub Sample4()
　　Dim v As Variant
　　Dim w() As Long
　　Dim gCnt As Long　'グループ数
　　Dim vTot() As Long
　　Dim vWk() As Long
　　Dim i As Long, x As Long, y As Long, z As Long

　　With Sheets("Sheet1")　 '<==実際のシート名に
　　　　x = .Cells(4, .Columns.Count).End(xlToLeft).Column
　　　　
　　　　If .Cells(4, x).Value = "Total" Then
　　　　　　.Columns(x).ClearContents
　　　　　　x = x - 1
　　　　End If
　　　　
　　　　gCnt = x - 4 - 1
　　　　ReDim vTot(1 To gCnt)
　　　　ReDim vWk(1 To gCnt)
　　　　y = .Range("A" & .Rows.Count).End(xlUp).Row
　　　　
　　　　If .Cells(y, 1).Value = "合計" Then
　　　　　　.Rows(y).ClearContents
　　　　　　y = y - 1
　　　　End If
　　　　
　　　　v = .Range("A5").Resize(y - 4, x).Value
　　　　ReDim w(LBound(v, 1) To UBound(v, 1))
　　　　For i = LBound(v, 1) To UBound(v, 1)
　　　　　　For z = 1 To gCnt
　　　　　　　　vWk(z) = v(i, 3) * v(i, z + 4)
　　　　　　　　w(i) = w(i) + vWk(z)
　　　　　　　　vTot(z) = vTot(z) + vWk(z)
　　　　　　Next
　　　　Next
　　　　.Cells(4, x + 1).Value = "Total"
　　　　.Cells(y + 1, 1).Value = "合計"
　　　　For i = 1 To gCnt
　　　　　　.Cells(y + 1, i + 4).Value = vTot(i)
　　　　Next
　　　　.Cells(5, x + 1).Resize(UBound(w)).Value = WorksheetFunction.Transpose(w)
　　End With
　
End Sub
【68744】Re:煩雑なデータ処理の解消方法は？？
お礼  マエ/ケン  - 11/4/13(水) 15:17 -
引用なし
パスワード
   問題解決！
本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2321 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free