[[20160516160218]]　『VBA「160まで達したら右のセルへ」』（ＱＰちゃん）　ページの最後に飛ぶ

『VBA「160まで達したら右のセルへ」』（ＱＰちゃん）

はじめまして。

ExcelVBAについて質問です。

D列の6行目から数字が入っています。最終行は変わる事があります。
D列を参照し、F列6行目から順にコピーしていくマクロを教えてください。

※ただし、1列辺り160までで、F列が160までいったらG列へ余りの数を入力され160までいったらまた次の列へ入力されるようにしたいです。
それの繰り返し処理をD列の最終行まで行う。

　ABC　　D　　E 　 F　　　G　　　H　　　I　　　J
1
2
3
4
5
6　　　　40　　　　　40　　
7　　　　40　　　　　40
8　　　　40　　　　　40
9　　　　60　　　　　40　20
10　　　60　　　　　　　　60
11　　　80　　　　　　　　80
12　　　200　　　　　　　　　　　160 　40
13　　　35　　　　　　　　　　　　　　　35
14　　　16　　　　　　　　　　　　　　　16
15　　　90　　　　　　　　　　　　　　　69　　21

マクロでF6からJ15までをボタン一つで自動入力されるようにしたいです。
説明不足な点があるかもしれませんが
宜しくおねがいします。

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 自分が見ても、美しくないコードですが、とりあえず。
 （もっと整理してからアップすべきでしょうけど。これから見直します）

 Sub Test()
    Const limit As Long = 160
    Dim pos As Range
    Dim tot As Long
    Dim c As Range
    Dim n As Long

    Set pos = Range("F5")

    For Each c In Range("D6", Range("D" & Rows.Count).End(xlUp))
        n = c.Value

        Do While n > 0

            If tot + n > limit Then
                Set pos = pos.Offset(1)
                pos.Value = limit - tot
                n = n - pos.Value
                tot = 0
                Set pos = pos.Offset(-1, 1)
            ElseIf tot + n = limit Then
                Set pos = pos.Offset(1)
                pos.Value = n
                n = n - pos.Value
                tot = tot + n
                tot = 0
                Set pos = pos.Offset(-1, 1)
            Else
                Set pos = pos.Offset(1)
                pos.Value = n
                tot = tot + n
                n = n - pos.Value
            End If
        Loop
    Next

 End Sub

（β） 2016/05/16(月) 19:47

１回アップしましたが、取り下げます

（マナ） 2016/05/16(月) 19:51

ちょっとだけ修正

 Sub test()
    Dim i As Long
    Dim b As Long
    Dim n As Long
    Dim x As Long

    For i = 6 To Cells(Rows.Count, "B").End(xlUp).Row
        b = Cells(i, "B").Value
        Do
            n = WorksheetFunction.Sum(Columns("F").Offset(, x))
            If n + b < 160 Then
                Cells(i, "F").Offset(, x).Value = b
                Exit Do
            Else
                Cells(i, "F").Offset(, x).Value = 160 - n
                b = b - (160 - n)
                x = x + 1
            End If
        Loop While b > 0
    Next

 End Sub

（マナ） 2016/05/16(月) 19:55

↑B列でなくD列でした。

（マナ） 2016/05/16(月) 20:02

 さすがマナさん。
 頭の中が、ぐちゃぐちゃのβとは大違いですね！

（β） 2016/05/16(月) 20:21

（β）さま、（マナ）さま、

ありがとうございます。
大変、助かりました。
（ＱＰちゃん） 2016/05/17(火) 12:29

コメント返信：

[ 一覧(最新更新順) ]

[[20160516160218]] 『VBA「160まで達したら右のセルへ」』（ＱＰちゃん） ページの最後に飛ぶ

[[20160516160218]]　『VBA「160まで達したら右のセルへ」』（ＱＰちゃん）　ページの最後に飛ぶ