Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
自動計算後に値を手打ちで変更し再計算
投稿日時: 21/10/22 16:59:11
投稿者: チワワのゾロ

他のファイルから数字を取り出して以下の様な納品計画を立てています。
 
  
 
自動抽出時
 
|頭出 |完納日 |期間 |戸数 |戸数av |合計 | 21/03 | 21/04 | 21/05 | 21/06 | 21/07 | 21/08 |
| 21/04 | 21/08 | 5 | 100 | 20 | 100 | | 20 | 20 | 20 | 20 | 20 |
 
客先との折衝の中で4月の納品戸数を40に変更することになったので4月の数字を40と手入力で変更します。
 
変更した瞬間
 
|頭出   |完納日 |期間 |戸数 |戸数av |合計 | 21/03 | 21/04 | 21/05 | 21/06 | 21/07 | 21/08 |
| 21/04 | 21/08 | 5 | 100 | 20 | 100 | | 40 | 20 | 20 | 20 | 20 |
 
総戸数は変更ないので 100-40=60 を残りの4ヶ月に平均して自動で振り分ける。
 
計算結果
 
|頭出 |完納日 |期間 |戸数 |戸数av |合計 | 21/03 | 21/04 | 21/05 | 21/06 | 21/07 | 21/08 |
| 21/04 | 21/08 | 5 | 100 | 20 | 100 | | 40 | 15 | 15 | 15 | 15 |
 
色々試しましたが毎回循環関数に壁にあたり期待値通りに進みません。
何かいい案は有りますでしょうか?ご教示願います。

回答
投稿日時: 21/10/22 17:44:16
投稿者: sk

引用:
客先との折衝の中で4月の納品戸数を40に変更することになったので
4月の数字を40と手入力で変更します。

引用:
総戸数は変更ないので 100-40=60 を残りの4ヶ月に
平均して自動で振り分ける。

・値が変更されたセルが 4 月以外の(より右の)列だった場合は
 どうしたいのか。
 (例えば、変更されたのが 5 月分の戸数だった場合は、
 「総戸数」と「 4 月(頭出月)から 5 月までの戸数の合計」の差を求め、
 それを 6 月から 8 月(完納月)までの月数( 3 )で除する等)
 
・仮に上記のような除算処理を行なうとして、「戸数」という単位の性質上、
 その商(平均)は整数値である(小数点以下の端数を含まないようにする)べきだと
 思われるが、もし 1 以上の剰余が生じた場合はどのように扱うのか。
 (いずれかの月の戸数に剰余をそのまま加える、もしくはいずれかの月に
  1 ずつ振り分ける。優先順位は不明)
 
とりあえず、以上の点について明記されることをお奨めします。

投稿日時: 21/10/22 18:31:08
投稿者: チワワのゾロ

ご指摘ありがとうございます。
 
  
 
・値が変更されたセルが 4 月以外の(より右の)列だった場合は
どうしたいのか。
 (例えば、変更されたのが 5 月分の戸数だった場合は、
 「総戸数」と「 4 月(頭出月)から 5 月までの戸数の合計」の差を求め、
 それを 6 月から 8 月(完納月)までの月数( 3 )で除する等)
 
>>>ご指摘の通り、4,5月の合計を総戸数から引き、残りの月数で割って平均戸数を出し
 各月に割り振りたいと思っています。
 
・仮に上記のような除算処理を行なうとして、「戸数」という単位の性質上、
 その商(平均)は整数値である(小数点以下の端数を含まないようにする)べきだと
 思われるが、もし 1 以上の剰余が生じた場合はどのように扱うのか。
 (いずれかの月の戸数に剰余をそのまま加える、もしくはいずれかの月に
  1 ずつ振り分ける。優先順位は不明)
 
 >>>確かに割り切れない事も考慮必要ですね。ありがとうございます。
 その場合は完納月に余りを足す事を考えておりました。

回答
投稿日時: 21/10/22 22:34:06
投稿者: WinArrow
投稿者のウェブサイトに移動

>循環関数に壁
マクロで数式をセルに代入せずに破裂変数で計算し、結果をセルに代入すれば
循環関数という壁はなくなると思いますよ!

回答
投稿日時: 21/10/22 22:49:48
投稿者: WinArrow
投稿者のウェブサイトに移動

ちょっとした疑問
>客先との折衝の中で4月の納品戸数を40に変更することになったので4月の数字を40と手入力で変更します。
なぜ、4月だけなんです?
他の月も一緒に確認すればよいのでは?
 
skさんより
例えば、5月より右の月
という話がありましたが、
4月はどうするのかと疑問はわかないのかな?

投稿日時: 21/10/23 11:12:36
投稿者: チワワのゾロ

なぜ、4月だけなんです?
他の月も一緒に確認すればよいのでは?
  
納品物を製作するのに工期がかかるため、一度には決まらないんです。
 
4月はどうするのかと疑問はわかないのかな?
 
5月の数字を変更する時は4月の数字が確定しているのです。
説明不足ですみませんでした。

回答
投稿日時: 21/10/23 22:06:46
投稿者: 半平太

 初期段階の各月の納品数はどう算出しているのですか?
「埋め込まれた数式を使って」ですか?
 
 その後、途中で月の戸数が変更となる訳ですが、変わるのはそれだけなのですか?
 現実問題として「合計戸数」とか「期間」とかの変更は発生しないのですか?

回答
投稿日時: 21/10/23 22:35:59
投稿者: WinArrow
投稿者のウェブサイトに移動

質問とは関係ありませんが、
なんとなく違和感があったので、書いておきます。
>総戸数
>納品戸数
何か所で「戸数」と表現していますが、
「戸数」ではなく、「個数」ですよね・・・・
 

回答
投稿日時: 21/10/24 10:27:06
投稿者: WinArrow
投稿者のウェブサイトに移動

初期の計算のロジックを提案します。
 

Sub 初期計算()
Dim 先頭列 As Long, 最終列 As Long
Dim D行 As Long, D列頭 As Long, D列完 As Long, D列平 As Long, D列合 As Long, D列数 As Long
Dim M行 As Long

Dim Cx As Long
Dim 合計 As Long, ENDCOL As Long


D行 = 2: M行 = 1: D列頭 = 1: D列平 = 5: D列合 = 6: D列完 = 2: D列数 = 4
先頭列 = 7: 最終列 = 13

'前提条件
'頭出し、完了日、期間は計算済と仮定する
'個数Avの計算式:ROUNDDOWN(個数/期間,0)
'合計の計算式:SUM関数
'頭出し、完了日、見出しの年月は、文字列で入力(日付形式ではない)

'計算式
    合計 = 0
    For Cx = 先頭列 To 最終列
        If Cells(M行, Cx).Value >= Cells(D行, D列頭).Value And Cells(M行, Cx).Value <= Cells(D行, D列完).Value Then
            Cells(D行, Cx).Value = Cells(D行, D列平).Value
            合計 = 合計 + Cells(D行, D列平).Value
            ENDCOL = Cx
        End If
    Next
'誤差調整
    If 合計 <> Cells(D行, D列数).Value Then
        Cells(D行, ENDCOL).Value = Cells(D行, ENDCOL).Value + Cells(D行, D列数).Value - 合計
    End If

End Sub

このコードの考え方は、初期設定という前提になっています。
問題は、このコードに一部修正/変更を組み込むとした場合、
(1)どこまでを確定、どこを修正したかをどのように判断させるか?
(2)このマクロをどのようにして起動させるか?
を検討する必要があります。
参考になるとよいですが・・・・
 

回答
投稿日時: 21/10/25 06:01:48
投稿者: simple

横から失礼します。
 
どこまでできていて、どこに詰まっているのでしょうか。
 
普通に考えると、こんな手順になりませんか?
これをステップごとにコードにしていけばよいのでは?
 

1. "変更個数"をInputBoxで入力させる
2. "変更個数"をアクティブセルに入力
3. その列の一行目から "変更月" を取得
4. "開始月"と"変更月"から、その月までを含む "納付回数" を計算
5. "既納付数"を算出(Application.SUMを利用)
6. "残余回数"を算出("期間"から"納付回数"を差し引く)
7. "残余数"を算出("合計"から"既納付数"を控除)
8. "新納付数"を算出
    ("残余数"を"残余回数"で割って整数未満切り捨て)
9. "新納付数"を翌月以降のセルに書き込む
10. 端数の調整は最後の月で行う。
    誤差=(残余数 - 新納付数 * 残余回数)を最後の月に加算

私は日付型(1日の年月日を持つ)にして、
表示を yy"年"mm"月" などとしたほうが使いやすいかと思いました。
 
なお、確認ですが、
4列目の"個数"と6列目の"合計"はどう違うんですか?同じものじゃないんですか?
 
# (用語の修正を行っただけで、内容は昨日の初回の投稿と同じです。)

回答
投稿日時: 21/10/25 15:40:14
投稿者: sk

引用:
ご指摘の通り、4,5月の合計を総戸数から引き、残りの月数で割って平均戸数を出し
各月に割り振りたいと思っています。

引用:
その場合は完納月に余りを足す事を考えておりました。

(シートモジュール)
----------------------------------------------------------------------
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
         
    '変更されたセルの数が 1 つではない場合
    If Target.Count <> 1 Then
        'プロシージャを抜ける
        Exit Sub
    End If
         
    '変更されたセルの行番号が 2 未満である場合
    If Target.Row < 2 Then
        'プロシージャを抜ける
        Exit Sub
    End If
     
    '変更されたセルの列番号が 7 未満である場合
    If Target.Column < 7 Then
        'プロシージャを抜ける
        Exit Sub
    End If
         
    '列見出し行から、頭出月に当たる列を検索
    Dim rngFirst As Range
    Set rngFirst = Rows(1).Find(Cells(Target.Row, 1).Value, _
                                Cells(1, 1), xlFormulas, _
                                xlWhole, xlByColumns)
    'ヒットしなかった場合
    If rngFirst Is Nothing Then
        'プロシージャを抜ける
        Exit Sub
    End If
     
    '変更されたセルの列番号が、頭出月の列番号より小さい(左の列である)場合
    If Target.Column < rngFirst.Column Then
        Set rngFirst = Nothing
        'プロシージャを抜ける
        Exit Sub
    End If
     
    '頭出月の戸数セルの参照
    Set rngFirst = Cells(Target.Row, rngFirst.Column)
     
    '列見出し行から、完納月に当たる列を検索
    Dim rngLast As Range
    Set rngLast = Rows(1).Find(Cells(Target.Row, 2).Value, _
                               Cells(1, 1), xlFormulas, _
                               xlWhole, xlByColumns)
    'ヒットしなかった場合
    If rngLast Is Nothing Then
        Set rngFirst = Nothing
        'プロシージャを抜ける
        Exit Sub
    End If
     
    '変更されたセルの列番号が、完納月の列番号以上場合
    If Target.Column >= rngLast.Column Then
        Set rngFirst = Nothing
        Set rngLast = Nothing
        'プロシージャを抜ける
        Exit Sub
    End If
     
    '完納月の戸数セルの参照
    Set rngLast = Cells(Target.Row, rngLast.Column)
 
    Dim lngTotal As Long
    Dim lngInprogressTotal As Long
    Dim lngDifference As Long
    Dim lngMonthCount As Long
    Dim lngQuotient As Long
    Dim lngRemainder As Long
     
    '総戸数の取得
    lngTotal = Cells(Target.Row, 4).Value
     
    '頭出月の戸数セルから変更されたセルまでの範囲の値の合計を取得
    lngInprogressTotal = WorksheetFunction.Sum(Range(rngFirst, Target))
     
    '両者の差(差分戸数)を取得
    lngDifference = lngTotal - lngInprogressTotal
     
    '差分戸数が 0 未満(マイナス値)である場合
    If lngDifference < 0 Then
        '強制的に 0 に変換
        lngDifference = 0
    End If
     
    '変更されたセルの1つ右のセルから完納月のセルまでの範囲の列数(差分月数)を取得
    lngMonthCount = Range(Target.Offset(0, 1), rngLast).Columns.Count
     
    '差分戸数を差分月数で除した結果(商)の取得
    lngQuotient = lngDifference \ lngMonthCount
    'その剰余を取得
    lngRemainder = lngDifference Mod lngMonthCount
     
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    '変更されたセルの1つ右のセルから完納月のセルまでの範囲に商を代入
    Range(Target.Offset(0, 1), rngLast).Value = lngQuotient
    '完納月の戸数セルには更に剰余を加える
    rngLast.Value = rngLast.Value + lngRemainder
     
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
     
    Set rngFirst = Nothing
    Set rngLast = Nothing
         
End Sub
----------------------------------------------------------------------
 
オートフィル機能によって 2 つ以上のセルの値が同時に変更されるケースを
無視するのであれば、以上のようなイベントプロシージャを実行するように
なさればよろしいのではないかと。

投稿日時: 21/10/26 19:39:01
投稿者: チワワのゾロ

 
初心者の私に丁寧に教えて頂きありがとうございました。