三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

XXXXXさんへ Excel VBA 質問にチャレンジ。デバッグ F8でステップ実行したり

下記の質問が来たので、チャレンジしてみました。

質問ですが、VBAで数値の足し算をしたいと思います。
内容は
A列に上から
20
15
8
90
16
とランダムに配列した数値を上から順に足し算していくのですが、ある一定の数値(33とします)になるくくりで数値を出していきます
説明がうまくできませんが、33人乗りのジェットコースターが来た時に、グループ毎にいる人たち(20人のグループ.15人のグループ.8人のグループ…)が乗るのを待っている時に、順番に乗り込んでいきますが、常に33人乗り満杯で発進したい場合
グループでどのような人数分けになるかを算出したいです
上記の並べた数値で答えを書きますと
20+15は、35なので33が定数なので2余りです
2は次にシフトして、2+8は、10ですから33に23足りません
次の90の中から23が入ります
その次は、90-23で67となり
67からは33、33、1となります
これを数値がある分全部処理をしていきます

問題
20
15
8
90
16

答え
1グループ 20 13
2グループ 2 8 23
3グループ 33 
4グループ 33
5グループ 1 17

最終グループはあまりですが
このように処理ができればと思います
33になるようにです

すみませんが、ご教示お願い致します。

いつもの動画解説
Excel VBA 質問に答えてみた デバッグ F8でステップ実行したりした。三流プログラマーのデバッグ風景 - YouTube
www.youtube.com

ソースと合わせてみて、テストしてみてください。

Option Explicit

Sub test20181116()

    Dim Gorup_Max As Integer    '最大の座席数 33
    Dim Group_no  As Integer    '結果 1グループ目、2グループ目を管理
    Dim Group_amari As Integer   '残りの座席

    Dim y As Integer   'Y行目
    Dim n As Integer   '列管理、内訳n個目の管理、

    Dim Next_noruhito As Integer    '次に乗る人 A列から取得
    Dim Noretahito    As Integer    '実際に乗れた人

    '初期化処理
    Gorup_Max = 33   '一台のMAX人数
    Group_no = 0

    y = 1 'A列1行目からチェックする
    Next_noruhito = Int(Cells(y, "A")) '次の人数を初期化といってもa1だけど

    Group_amari = Gorup_Max  '一番最初は全席空いてます、トリガー?で初期化
    
    'A列乗る人がゼロになるまでループ
    While Next_noruhito > 0  '乗る予定の人が0以上、次に乗る人が居る間ループする
        '全席空いていたら、次のグループを用意する
        If Group_amari = Gorup_Max Then  '空席=もMAXかチェックする
            'B列にグループ見出しを書き込む
            Group_no = Group_no + 1  'グループの通し番号を増やす
            Cells(Group_no, "B") = Group_no & "グループ"
            n = 0 'グループ内の列管理を0にする
            Group_amari = Gorup_Max  '新しいグループは全席空いてます、あっいらないか
        End If
    
        '席に座る処理
        '次に乗る希望人数が全員乗れるか?空いている席と比べてチェックする
        If Next_noruhito <= Group_amari Then  '乗りたい人と空席を比べる
            '希望者全員乗れたのでグループに乗った人数を書き込む
            Cells(Group_no, 3 + n) = Next_noruhito 'C列(3)+グループ内列番
            n = n + 1  '次のセット位置に移動したいので
            
            '乗った人の分空席が減る
            Group_amari = Group_amari - Next_noruhito '単純に空席を減らす
            
            '全員無事に乗れたので次の人数を次の行から取得する
            y = y + 1 '次の行
            Next_noruhito = Int(Cells(y, "A")) '次の人数をセットする
        Else
            '座席が足りなかった時※乗りたい人が多かったとき
            Noretahito = Group_amari '乗れた人は空席の数だけ乗れた
            
            '次に乗る予定の人を計算(今乗れなかった人)
            Next_noruhito = Next_noruhito - Noretahito  '乗る予定から乗れた人を引くと次乗る人
            '↑ここで、ぴったり乗れた時は、次に乗る人が0の時は次のA列から取得したい
            If Next_noruhito = 0 Then
                y = y + 1 '次の行
                Next_noruhito = Int(Cells(y, "A")) '次の人数をセットする
            End If
            
            '乗れた人をグループに記入する
            Cells(Group_no, 3 + n) = Noretahito 'C列(3)+グループ内列番
            n = n + 1  '次のセット位置に移動したいので、あっいらないか
            
            '空席が無くなったので、次のグループを準備する、トリックしかけ
            Group_amari = Gorup_Max  '新しいグループは全席空いてます
            '↑全席空いているをフラグ代わりに使ったトリック
        End If
    Wend
    

End Sub


蛇足の修正

Sub test20181116_002()

    Dim Gorup_Max As Integer    '最大の座席数 33
    Dim Group_no  As Integer    '結果 1グループ目、2グループ目を管理
    Dim Group_amari As Integer   '残りの座席

    Dim y As Integer   'Y行目
    Dim n As Integer   '列管理、内訳n個目の管理、

    Dim Next_noruhito As Integer    '次に乗る人 A列から取得
    Dim Noretahito    As Integer    '実際に乗れた人

    '結果を消す
    Columns("B:E").Select
    Selection.ClearContents

    '初期化処理
    Gorup_Max = 33   '一台のMAX人数
    Group_no = 0

    y = 1 'A列1行目からチェックする
    Next_noruhito = Int(Cells(y, "A")) '次の人数を初期化といってもa1だけど

    Group_amari = Gorup_Max  '一番最初は全席空いてます、トリガー?で初期化
    
    'A列乗る人がゼロになるまでループ
    While Next_noruhito > 0  '乗る予定の人が0以上、次に乗る人が居る間ループする
        '全席空いていたら、次のグループを用意する
        If Group_amari = Gorup_Max Then  '空席=もMAXかチェックする
            'B列にグループ見出しを書き込む
            Group_no = Group_no + 1  'グループの通し番号を増やす
            Cells(Group_no, "B") = Group_no & "グループ"
            n = 0 'グループ内の列管理を0にする
            'Group_amari = Gorup_Max  '新しいグループは全席空いてます、あっいらないか
        End If
    
        '席に座る処理
        '次に乗る希望人数が全員乗れるか?空いている席と比べてチェックする
        If Next_noruhito <= Group_amari Then  '乗りたい人と空席を比べる
            '希望者全員乗れたのでグループに乗った人数を書き込む
            Noretahito = Next_noruhito '
            
            '乗った人の分空席が減る
            Group_amari = Group_amari - Next_noruhito '単純に空席を減らす
            
            '全員無事に乗れたので次の人数を次の行から取得する
            Next_noruhito = 0
        Else
            '座席が足りなかった時※乗りたい人が多かったとき
            Noretahito = Group_amari '乗れた人は空席の数だけ乗れた
            
            '次に乗る予定の人を計算(今乗れなかった人)
            Next_noruhito = Next_noruhito - Noretahito  '乗る予定から乗れた人を引くと次乗る人
            '↑ここで、ぴったり乗れた時は、次に乗る人が0の時は次のA列から取得したい
            
            
            '空席が無くなったので、次のグループを準備する、トリックしかけ
            Group_amari = Gorup_Max  '新しいグループは全席空いてます
            '↑全席空いているをフラグ代わりに使ったトリック
        End If

        '乗れた人をグループに記入する
        Cells(Group_no, 3 + n) = Noretahito 'C列(3)+グループ内列番
        n = n + 1  '次のセット位置に移動したいので、

        '次の人を取得する
        If Next_noruhito = 0 Then
             y = y + 1 '次の行
             Next_noruhito = Int(Cells(y, "A")) '次の人数をセットする
        End If
    
    Wend
    

End Sub

解決の糸口となれば幸いです。 三流プログラマー Ken3

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)