ジメジメする梅雨のお悩み、一挙解決! >>

いつもお世話になります。

A列に品番、B列に品名(*****部分)、C列に数値が入っています。小計行と総計行のA列は空白です。
このような表で、D列にC列の数量の比率(%)を入力していくマクロを組みたいと思っています。
A列の空白行と空白行に挟まれたまとまりに対し、C列の数値の合計を100%とした比率を
D列に入力していきたいのです。A列の行は可変で最終行はその時によって変わります。
下のようなイメージなのですが、うまく間隔が取れず、見づらくなってしまいました。
すみません...

   A     B      C    D
  品番    品名    数量  比率
商品A1aaa *********** 45   0%
商品A1bbb *********** 1,500   5%
商品A1ccc *********** 215  1%
商品A1ddd *********** 492  2%
商品A1eee *********** 8,974  30%
商品A1fff *********** 5,656  19%
商品A1ggg *********** 8,603  28%
商品A1hhh *********** 4,723  16%
     商品A1 Total   30,208  100%
商品A2aaa *********** 2  0%
商品A2bbb *********** 100  1%
商品A2ccc *********** 150  1%
商品A2ddd *********** 1,500  11%
商品A2eee *********** 4,800  36%
商品A2fff *********** 6,600  50%
     商品A2 Total 13,152  100%
      商品A Total    56,137
商品B1aaa *********** 13,509  100%
      商品B1 Total 13,509  100%
商品B2aaa *********** 14   1%
商品B2bbb *********** 1,073  45%
商品B2ccc *********** 1,290  54%
      商品B2 Total  2,377  100%
商品B3aaa *********** 3,171  100%
      商品B3 Total 3,171  100%
商品B4aaa *********** 251  100%
      商品B4 Total 251  100%
商品B5aaa *********** 1,154  35%
商品B5bbb *********** 2,136  65%
     商品B5 Total 3,290  100%
商品B6aaa *********** 2,388  100%
      商品B6 Total 2,388
       商品B Total 24,986


Sub Sample1()
Dim i As Long, k As Long
Dim lastRow As Long, myRng As Range
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
Range("D:D").Style = "Percent"
For i = 2 To lastRow
Set myRng = Cells(i, "A").End(xlDown).Offset(1, 2)
For k = i To myRng.Row
Cells(k, "D") = Cells(k, "C") / myRng
Next k
i = myRng.Row
Next i
End Sub

上のコードで、行が複数あるかたまりが続いている間はうまくいくのですが、
1行しかないかたまりが来ると参照する行がずれて変な値になってしまいます。
また、総計行が入っているところでもずれます。
1行しかないかたまりや小計行の間に総計行がある上のような表に対応するには
どのようなコードを書けばよいのでしょうか。
アドバイスお願いします。

  • 画像を添付する (ファイルサイズ:10MB以内、ファイル形式:JPG/GIF/PNG)
  • 今の自分の気分スタンプを選ぼう!
あと4000文字

A 回答 (4件)

こんにちは!



おそらく前回当方が投稿したものだと思います。
ちょっとやり方を変えてみました。

Sub Sample2()
 Dim lastRow As Long
 Dim c As Range, r As Range
 Dim myTotal As Range, myArea As Range, myR As Range
  Range("D:D").Style = "Percent"
  lastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Set c = Range("A2")
    Do
     If c.Offset(1) <> "" Then
      Set r = c.End(xlDown)
     Else
      Set r = c
     End If
      If r.Offset(1) = "" Then
       Set myTotal = r.Offset(1, 2)
       Set myArea = Range(Cells(c.Row, "C"), Cells(r.Row + 1, "C"))
        For Each myR In myArea
         myR.Offset(, 1) = myR / myTotal
        Next myR
       Set c = r
      End If
       If r.Row = c.Row Then
        Set c = r.End(xlDown)
       End If
      If c.Row > lastRow Then Exit Do
    Loop
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 1

No.1です。


小計行/総計行の品番が完全な空白でないときにオーバーフローしました。
一応ご報告まで。
    • good
    • 1

こんなやり方は、いかがでしょう。


合計行の100%の入れ方が、ちょっと強引です。

Sub sample()
Dim r As Range, r1 As Range, r2 As Range
Range("D:D").Style = "Percent"
Set r = Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants, 23)
For Each r1 In r.Areas
Set r2 = r1(r1.Count).Offset(1, 2)
r1.Offset(, 3).FormulaR1C1 = "=RC[-1]/" & r2.Address(True, True, xlR1C1)
r2.Offset(, 1) = 1
Next r1
End Sub
    • good
    • 1
この回答へのお礼

回答ありがとうございます!思い通りの結果になりました!
100%の入れ方は「なるほど」ですね笑。今のところ小計の集計と合計行の値が一致しないことは稀なのでほとんど問題ないです。欲を言えば、別の列にコピーすることを想定して列を相対参照にできればよりよいのですが、難しかったです...。めちゃくちゃ強引ですが、

r1.Offset(, 3).FormulaR1C1 = "=RC[-1]/" & r2.Address(True, False, xlR1C1)

として一旦相対参照の式にしてから

Columns("D:D").Replace What:="F", Replacement:="C"

で分母の参照セルをC列に変えることで、とりあえず得たい結果にはなりました汗。大変初心者なのでまだまだ勉強しないといけないです。

貴重なアドバイスどうもありがとうございました!
今後ともよろしくお願いしますm(_ _)m

お礼日時:2018/06/16 20:29

こんな感じかな?


Sub Sample2()
Dim i As Long
Dim lastRow As Long, myRng As Range
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
Range("D:D").Style = "Percent"
For i = lastRow To 2 Step -1
If IsEmpty(Cells(i, "A").Value) And Not IsEmpty(Cells(i - 1, "A").Value) Then
Set myRng = Cells(i, "C")
End If
If Not IsEmpty(Cells(i, "A").Value) Or Not IsEmpty(Cells(i - 1, "A").Value) Then
Cells(i, "D").Value = Cells(i, "C").Value / myRng.Value
End If
Next i
End Sub
    • good
    • 1
この回答へのお礼

一番に回答いただきありがとうございます!動かしてみたのですが、
「オーバーフローしました」というエラーがでました。せっかくなので構文を活かしてLongをVariantに変えてみたり、For Nextをネストして自分で少しいじってみたりもしたのですが、うまくいかず...でも勉強になりました!貴重なお時間ありがとうございますm(_ _)m

お礼日時:2018/06/16 14:27

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング

おすすめ情報