Excel VBA質問箱 IV

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

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


11167 / 13646 ツリー ←次へ | 前へ→

【17623】合計と件数の算出について キタ 04/9/3(金) 15:17 質問[未読]
【17624】Re:合計と件数の算出について Asaki 04/9/3(金) 15:39 回答[未読]
【17625】Re:合計と件数の算出について キタ 04/9/3(金) 15:57 質問[未読]
【17626】Re:合計と件数の算出について Asaki 04/9/3(金) 16:05 回答[未読]
【17628】Re:合計と件数の算出について キタ 04/9/3(金) 17:30 質問[未読]
【17705】Re:合計と件数の算出について Jaka 04/9/6(月) 9:15 発言[未読]
【17707】Re:合計と件数の算出について キタ 04/9/6(月) 10:16 質問[未読]
【17743】Re:合計と件数の算出について Jaka 04/9/7(火) 9:19 回答[未読]
【17642】Re:合計と件数の算出について Kein 04/9/3(金) 20:37 発言[未読]

【17623】合計と件数の算出について
質問  キタ  - 04/9/3(金) 15:17 -

引用なし
パスワード
   みなさん、こんにちは。いきなりですが教えてください。
以下のような表があります。
G〜M列に数値(シリアル値)が入力されており、それらがいくつもの
グループになっています。(A〜F列には文字が入力されています。)
それらのグループの列の合計と件数を算出したく、下のコードを
使ったのですが、H〜M列の合計はでるのですが、H列の合計はH列の件数が
足された形で算出されてしまいます。
私のイメージとしては、例えば最初のグループで言うと、11行目に件数が、12行目に
合計が算出し、他のグループも同様にしたいのです。一番最終行には、トータルの
合計と件数を出力させます。
どうやってもうまくいきません。どなたかご教授をお願い致します。
ちなみに、このコードは過去の投稿を参考にさせてもらっています。

  A B C D E F G  H  I  J  K  L  M
1〜6行は空白です。

7       100  2  50 60 78 80 90
8        90 11  13 25 22 11  3
9        5  5  5  5  5  5  5
10        1  2  3  4  4  5  1
11
12
13
14        2 11  15 10 80 91  2 
15       10  4  5  6  6  6  6
16              ・
17              ・
18              ・
19

------------------------------------------------------------------
Sub PLAS()

  Dim i As Long
  Dim j As Long
  Dim 先頭行 As Long
  Dim 最終行 As Long
  Dim 対象データ As Variant
  Dim 合計(5) As Variant
  Dim 小計(5) As Variant
  Dim ブランク As Boolean
 
With ActiveSheet
    先頭行 = 7
    最終行 = .Cells(65536, "G").End(xlUp).ROW + 1
    For i = 先頭行 To 最終行
      対象データ = .Cells(i, "G").Resize(, 6).Value
      If 対象データ(1, 1) = "" Then
        If ブランク Then
          .Cells(i, "G").Resize(, 6).Value = 小計
         
          .Cells(i, "G").Resize(, 6).Font.Bold = True
          For j = 0 To 5
            合計(j) = 合計(j) + 小計(j)
            小計(j) = 0
          Next j
          ブランク = False
        End If
      Else
        If 対象データ(1, 1) <> "" Then
          ブランク = True
          If IsNumeric(Trim(対象データ(1, 1))) Then
            小計(0) = 小計(0) + 1
          End If
         
          For j = 0 To 5
           
            小計(j) = 小計(j) + Val(対象データ(1, 1 + j))
          

          Next j
        End If
      End If
    Next i
    .Cells(i, "G").Resize(, 6).Value = 合計
    .Cells(i, "G").Resize(, 6).Font.Bold = True
    
  End With
End Sub

【17624】Re:合計と件数の算出について
回答  Asaki  - 04/9/3(金) 15:39 -

引用なし
パスワード
   こんにちは。

ご提示の例で、ご提示のマクロをそのまま動かすと
G列からL列まで合計らしきものが表示され、M列は計算対象外のようです。
で、G列の合計が、さらに件数を加算された形になっているようですが、
結局、
各グループの最終行の次の行のH列に件数
さらに次の行にGからM列の数値の合計
ですか?

【17625】Re:合計と件数の算出について
質問  キタ  - 04/9/3(金) 15:57 -

引用なし
パスワード
   Asakiさんこんにちは。
各グループ最終行の次の行に各列毎の件数の合計を各列に算出し、その次の行に
各列毎の金額の合計を各列に算出したいのです。
よろしくお願いします。

【17626】Re:合計と件数の算出について
回答  Asaki  - 04/9/3(金) 16:05 -

引用なし
パスワード
   >小計(0) = 小計(0) + 1
↑この行で件数を数えて、(ちなみに、G列の件数を数えてますが)
そのすぐ下で
>For j = 0 To 5
>  小計(j) = 小計(j) + Val(対象データ(1, 1 + j))
>Next j
と、小計(0)の場合も1から5と同様に対象データを加算しているのが原因と思いますが。

>各列毎の件数の合計を各列に算出
ご提示の例では、件数はどの列も同じに見えますが、違う場合もあるのですか?
それなら、件数を数える配列をもう1つ追加して、全列に対して計数処理を追加するようにしないとだめなのでは?

【17628】Re:合計と件数の算出について
質問  キタ  - 04/9/3(金) 17:30 -

引用なし
パスワード
   金額の合計に件数の合計が加算された理由は分かりました。
件数の算出について、私の説明不足でしたので、以下のとおり補足します。
7〜10行までにある数値の件数を11行目に、金額の合計を12行目に、それぞれ
各列毎に算出します。
新たな配列を組むべきだとは思いますが、どのように手を加えたら良いのかが
わかりません。私なりに勉強してはいるのですが、うまくいかないのです。
大変身勝手な質問だとは思いますが、よろしくお願いいたします。

  A B C D E F G  H  I  J  K  L  M  N
7        100 10  2  3      5  5
8        110        2      7
9         2    2          6
10        53  3        4
11        4  2  2  1  1  1  1  3
12        265 13  4  3  2  4  5 18
13

【17642】Re:合計と件数の算出について
発言  Kein  - 04/9/3(金) 20:37 -

引用なし
パスワード
   >グループになっています。(A〜F列には文字が入力されています。)
A:F にグループの基準になる項目があるなら、集計機能を使えば速いですよ。
マクロにするなら Subtotalメソッドの引数で、Replace:=False にしておけば
合計と件数を連続して処理できます。集計行は 2行になります。アウトラインが
鬱陶しいなら、Cells.ClearOutLine を追加すれば良いでしょう。
マクロの自動記録を ON にして、手作業でテストしてみて下さい。

【17705】Re:合計と件数の算出について
発言  Jaka  - 04/9/6(月) 9:15 -

引用なし
パスワード
   こんにちは。
現在までの状況を把握してません。

また、↓入ってません。
>7〜10行までにある数値の件数を11行目に、金額の合計を12行目に、それぞれ
>各列毎に算出します。


Sub PLAS()
  Dim i As Long
  Dim j As Long
  Dim 先頭行 As Long
  Dim 最終行 As Long
  Dim 対象データ As Variant
  Dim 合計(5) As Variant
  Dim 小計(5) As Variant
  Dim ブランク As Boolean

  With ActiveSheet
    先頭行 = 7
    最終行 = .Cells(65536, "G").End(xlUp).Row + 1
    For i = 先頭行 To 最終行

      .Cells(i, "G").Resize(, 7).Select '←確認用に1度入れてみるといいです。
      
      対象データ = .Cells(i, "G").Resize(, 6).Value
      If 対象データ(1, 1) = "" Then
        If ブランク Then
          .Cells(i, "G").Resize(, 7).Value = 小計
          .Cells(i, "G").Resize(, 7).Font.Bold = True
          For j = 0 To 5
            合計(j) = 合計(j) + 小計(j)
            小計(j) = 0
          Next j
          ブランク = False
        End If
      Else
        If 対象データ(1, 1) <> "" Then
          ブランク = True
          If IsNumeric(Trim(対象データ(1, 1))) Then
           小計(0) = 小計(0) + 1
          End If
          For j = 0 To 6
            小計(j) = 小計(j) + Val(対象データ(1, j))
          Next j
        End If
      End If
    Next i
    .Cells(i, "G").Resize(, 7).Value = 合計
    .Cells(i, "G").Resize(, 7).Font.Bold = True
  End With
End Sub

**********************
Sub sgh()
  Dim Cure As Range, Gcure As Range, STR As Range, GK() As Long
  Dim CCR As Long
  Set STR = Range("G7")
  CCR = STR.End(xlDown).End(xlToRight).Column - STR.Column + 1
  ReDim GK(1 To CCR)
  Do Until STR.End(xlDown).Row = 65536
    Set STR = STR.End(xlDown)
    With STR 'Range("G8")
      Set Gcure = Nothing
      Set Cure = .CurrentRegion
      With Cure
         Set Gcure = .Offset(.Rows.Count).Resize(1)
         For i = 1 To .Cells.Columns.Count
          Gcure.Cells(i).Value = Application.Sum(.Cells.Columns(i))
          Gcure.Cells(i).Font.Bold = True
          GK(i) = GK(i) + Application.Sum(.Cells.Columns(i))
         Next
      End With
    End With
    Set STR = Gcure.Cells(i)
    Set Cure = Nothing
  Loop
  Gcure.Cells(i).Resize(, CCR).Value = GK
  Gcure.Cells(i).Resize(, CCR).Font.Bold = True
  Set STR = Nothing
  Set Gcure = Nothing
  Erase GK
  End
End Sub

【17707】Re:合計と件数の算出について
質問  キタ  - 04/9/6(月) 10:16 -

引用なし
パスワード
   jakaさん、おはようございます。
ご教示の内容を確認させていただきました。
当初の質問の確認をさせていただきますが、下図のようにいくつかのグループが
あります。(7〜10行目、14〜15行目)それらの各グループの各列の数値の合計と
件数を算出します。グループの最終行の次の行に件数の合計を、そして次の行に
数値の合計を、最終的に全部の合計を、最後のグループの合計の次の行に
算出させたいということでした。keinさんのご教示の内容を試させて
いただきましたが、以下のようになりました。
まず、最初のグループについてですが、G列の件数は11行目に出ましたが、数値の合計
は、その件数も含まれた合計になってしまいますので、この件数を含めず算出したいのです。
それから、H〜N列の件数の合計も算出させたいのです。A〜F列は文字列が入力されていますので
これらの計は必要ありません。
次に2つ目のグループですが、14〜15行のデータの件数は16行目に、そして全体の件数の合計が
17行目に出ていますので問題ありませんが、これもやはり、H〜N列の件数計がでません。
18行目、19行目も同様です。
私的には、例えば最初のグループでいうと、G列7〜10行目の件数計をG列11行目に(4です)、
数値の合計を12行目に(265です)、次のグループでは、G列14〜15行目の件数計を16行目に
(2です)、数値の合計を17行目に(15です)、そして全体の数値の合計を18行目に(6です)、
数値の合計を19行目に(280です)算出し、他のH列〜N列も同様にしたいのです。
私も色々試し、四苦八苦しているところですが、わかりません。
申し訳ありませんが、またのご教授をお願い致します。

  A B C D E F  G  H  I  J  K  L  M  N  O  P Q 
7            100 10  2  3      5  5
8            110        2      7
9             2    2          6
10            53  3        4
11            4 
12 0 0 0 0 0 0  269 13  4  3  2  4  5 18
13
14            10  2  3          1
15            5      5  5
16            2  0  0  0  0  0  0  0
17            6  0  0  0  0  0  0  0
18 0 0 0 0 0 0   23  2  3  5  5  0  0  1 0  0  0 0 ...
19 0 0 0 0 0 0  292  2  3  5  5  0  0  1 0  0  0 0 ...


▼Jaka さん:
>こんにちは。
>現在までの状況を把握してません。
>
>また、↓入ってません。
>>7〜10行までにある数値の件数を11行目に、金額の合計を12行目に、それぞれ
>>各列毎に算出します。
>
>
>Sub PLAS()
>  Dim i As Long
>  Dim j As Long
>  Dim 先頭行 As Long
>  Dim 最終行 As Long
>  Dim 対象データ As Variant
>  Dim 合計(5) As Variant
>  Dim 小計(5) As Variant
>  Dim ブランク As Boolean
>
>  With ActiveSheet
>    先頭行 = 7
>    最終行 = .Cells(65536, "G").End(xlUp).Row + 1
>    For i = 先頭行 To 最終行
>
>      .Cells(i, "G").Resize(, 7).Select '←確認用に1度入れてみるといいです。
>      
>      対象データ = .Cells(i, "G").Resize(, 6).Value
>      If 対象データ(1, 1) = "" Then
>        If ブランク Then
>          .Cells(i, "G").Resize(, 7).Value = 小計
>          .Cells(i, "G").Resize(, 7).Font.Bold = True
>          For j = 0 To 5
>            合計(j) = 合計(j) + 小計(j)
>            小計(j) = 0
>          Next j
>          ブランク = False
>        End If
>      Else
>        If 対象データ(1, 1) <> "" Then
>          ブランク = True
>          If IsNumeric(Trim(対象データ(1, 1))) Then
>           小計(0) = 小計(0) + 1
>          End If
>          For j = 0 To 6
>            小計(j) = 小計(j) + Val(対象データ(1, j))
>          Next j
>        End If
>      End If
>    Next i
>    .Cells(i, "G").Resize(, 7).Value = 合計
>    .Cells(i, "G").Resize(, 7).Font.Bold = True
>  End With
>End Sub
>
>**********************
>Sub sgh()
>  Dim Cure As Range, Gcure As Range, STR As Range, GK() As Long
>  Dim CCR As Long
>  Set STR = Range("G7")
>  CCR = STR.End(xlDown).End(xlToRight).Column - STR.Column + 1
>  ReDim GK(1 To CCR)
>  Do Until STR.End(xlDown).Row = 65536
>    Set STR = STR.End(xlDown)
>    With STR 'Range("G8")
>      Set Gcure = Nothing
>      Set Cure = .CurrentRegion
>      With Cure
>         Set Gcure = .Offset(.Rows.Count).Resize(1)
>         For i = 1 To .Cells.Columns.Count
>          Gcure.Cells(i).Value = Application.Sum(.Cells.Columns(i))
>          Gcure.Cells(i).Font.Bold = True
>          GK(i) = GK(i) + Application.Sum(.Cells.Columns(i))
>         Next
>      End With
>    End With
>    Set STR = Gcure.Cells(i)
>    Set Cure = Nothing
>  Loop
>  Gcure.Cells(i).Resize(, CCR).Value = GK
>  Gcure.Cells(i).Resize(, CCR).Font.Bold = True
>  Set STR = Nothing
>  Set Gcure = Nothing
>  Erase GK
>  End
>End Sub

【17743】Re:合計と件数の算出について
回答  Jaka  - 04/9/7(火) 9:19 -

引用なし
パスワード
   データレイアウトの記述は手抜きしないでちゃんと書いてください。
こちらは、提示されたデータレイアウトでコード書いていますので....。

最初に書いたコードを
このデータだけで試してみてください。

  A B C D E F G  H  I  J  K  L  M
1〜6行は空白です。

7       100  2  50 60 78 80 90
8        90 11  13 25 22 11  3
9        5  5  5  5  5  5  5
10        1  2  3  4  4  5  1
11
12
13
14        2 11  15 10 80 91  2 
15       10  4  5  6  6  6  6

*********************
Sub sffgh3()
  Dim Cure As Range, Gcure As Range, STR As Range, GK() As Long
  Dim CCR As Long
  Set STR = Range("G7")
  CCR = 8
  ReDim GK(1 To CCR)
  Do Until STR.End(xlDown).Row = 65536
    With STR
      Set Gcure = Nothing
      SSR = STR.End(xlDown).Row - STR.Row + 1
      Set Cure = STR.Resize(SSR, CCR)
      With Cure
         Set Gcure = .Offset(.Rows.Count).Resize(1)
         For i = 1 To .Cells.Columns.Count
          Gcure.Cells(i).Value = Application.Sum(.Cells.Columns(i))
          Gcure.Cells(i).Font.Bold = True
          GK(i) = GK(i) + Application.Sum(.Cells.Columns(i))
         Next
      End With
    End With
    Set STR = Gcure.Cells(i).End(xlDown)
    Set Cure = Nothing
  Loop
  Gcure.Cells(i).Resize(, CCR).Value = GK
  Gcure.Cells(i).Resize(, CCR).Font.Bold = True
  Set STR = Nothing
  Set Gcure = Nothing
  Erase GK
  End
End Sub

11167 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free