teratail
回答率
85.31%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問VBAで、複数行あるカテゴリーごとの合計値の算出ができない

編集履歴

回答編集履歴

3

小計⇒合計

2025/04/23 02:21

投稿

Black_Velvet
Black_Velvet

スコア116

test CHANGED
@@ -32,8 +32,8 @@
32
32
  'A列に｢合計｣の文字が含まれる場合
33
33
  .Cells(R, C(i)).Value = Total(i)
34
34
  Total(i) = 0
35
- ElseIf InStr(.Cells(R, 2).Value, "小計") > 0 Then
35
+ ElseIf InStr(.Cells(R, 2).Value, "合計") > 0 Then
36
- 'B列に｢小計｣の文字が含まれる場合
36
+ 'B列に｢合計｣の文字が含まれる場合
37
37
  .Cells(R, C(i)).Value = Subtotal(i)
38
38
  Total(i) = Total(i) + Subtotal(i)
39
39
  Subtotal(i) = 0

2

質問内容に適合させました

2025/04/23 01:43

投稿

Black_Velvet
Black_Velvet

スコア116

test CHANGED
@@ -2,11 +2,12 @@
2
2
 
3
3
  ```VBA
4
4
  Sub Calc()
5
+ Dim ws As Worksheet
6
+ Dim i As Long
5
7
  Dim R As Long
6
8
  Dim C As Variant
7
- Dim totalSum() As Variant
9
+ Dim Total() As Variant
8
- Dim ws As Worksheet
10
+ Dim Subtotal() As Variant
9
- Dim i As Long
10
11
 
11
12
  ' シートを指定
12
13
  Set ws = ThisWorkbook.Sheets("収益状況")
@@ -15,23 +16,32 @@
15
16
  C = Array(12, 13, 14, 18, 19, 20, 21, 24, 25, 26, 27, 28, 29, 30, _
16
17
  34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48)
17
18
 
19
+ ReDim Subtotal(UBound(C)) As Variant
18
- ReDim totalSum(UBound(C)) As Variant
20
+ ReDim Total(UBound(C)) As Variant
21
+
22
+ For i = LBound(C) To UBound(C)
23
+ Subtotal(i) = 0
24
+ Total(i) = 0
25
+ Next i
19
26
 
20
27
  R = 6
21
28
  With ws
22
29
  Do While R < 41
30
+ For i = LBound(C) To UBound(C)
23
- If InStr(.Cells(R, 1).Value, "合計") > 0 Then
31
+ If InStr(.Cells(R, 1).Value, "合計") > 0 Then
24
- 'A列に｢合計｣の文字が含まれる場合
32
+ 'A列に｢合計｣の文字が含まれる場合
25
- For i = LBound(C) To UBound(C)
26
- .Cells(R, C(i)).Value = totalSum(i)
33
+ .Cells(R, C(i)).Value = Total(i)
27
- totalSum(i) = 0
34
+ Total(i) = 0
35
+ ElseIf InStr(.Cells(R, 2).Value, "小計") > 0 Then
36
+ 'B列に｢小計｣の文字が含まれる場合
37
+ .Cells(R, C(i)).Value = Subtotal(i)
38
+ Total(i) = Total(i) + Subtotal(i)
39
+ Subtotal(i) = 0
40
+ Else
41
+ 'いずれの文字が含まれない場合
42
+ Subtotal(i) = Subtotal(i) + .Cells(R, C(i)).Value
43
+ End If
28
- Next i
44
+ Next i
29
- Else
30
- 'A列に｢合計｣の文字が含まれない場合
31
- For i = LBound(C) To UBound(C)
32
- totalSum(i) = totalSum(i) + .Cells(R, C(i)).Value
33
- Next i
34
- End If
35
45
  R = R + 1
36
46
  Loop
37
47
  End With

1

｢合計｣の文字がB列ではなくA列だった

2025/04/23 01:18

投稿

Black_Velvet
Black_Velvet

スコア116

test CHANGED
@@ -20,14 +20,14 @@
20
20
  R = 6
21
21
  With ws
22
22
  Do While R < 41
23
- If InStr(.Cells(R, 2).Value, "合計") > 0 Then
23
+ If InStr(.Cells(R, 1).Value, "合計") > 0 Then
24
- 'B列に｢合計｣の文字が含まれる場合
24
+ 'A列に｢合計｣の文字が含まれる場合
25
25
  For i = LBound(C) To UBound(C)
26
26
  .Cells(R, C(i)).Value = totalSum(i)
27
27
  totalSum(i) = 0
28
28
  Next i
29
29
  Else
30
- 'B列に｢合計｣の文字が含まれない場合
30
+ 'A列に｢合計｣の文字が含まれない場合
31
31
  For i = LBound(C) To UBound(C)
32
32
  totalSum(i) = totalSum(i) + .Cells(R, C(i)).Value
33
33
  Next i