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の5行目から最終行まで)
 列合計=ΣPrice×Group01 (Sheet1の5行目から最終行まで)
     ・
     GroupTotalの前列まで
 毎日、計算式を埋め込んで、結構手間。。。
 何かいい方法あるのでしょうか?ぜひご伝授ください。
 
ItemNo. ItemName Price ・Unit Group01 Group02 ・GroupTotal
A001  ア001 100   グラム  10    20       30
A002  イ001 200   グラム  30    40       70



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

ItemNo. ItemName Price ・Unit Group01 Group02 ・GroupTotal Total
A001  ア001 10    グラム  10    20     30     300
A002  イ001 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 -

引用なし
パスワード
   ▼マエ/ケン さん:

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

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〜O17、
   メッセージ内容→「インデックスが有効範囲にはありません。」


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〜O17、
>   メッセージ内容→「インデックスが有効範囲にはありません。」

このメッセージが出たときに黄色く光っていたコードはどこでしたか?

【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の5行目から最終行まで)
> 列合計=ΣPrice×Group01 (Sheet1の5行目から最終行まで)

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

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にちょっとだけ追加。
これで、合計があってもなくてもOKです。

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