質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.76%

  • VBA

    1647questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コードが全然短くなりません。アドバイスお願いします。

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 347

King_of_Flies

score 296

VBAのツールで下記メソッドを実装しました。

パターンごとにIf分岐しているのですが、
さすがに長いと思わざるを得ません。

withを使用しようかとも考えましたが、
見ずらくなりましたので、戻しました。
cellDateFromは報告期間FROM
cellDateToには報告期間TO
cellDateBには作業着手予定日
cellDateCには作業完了予定日
でそれぞれDate型です。

cellDateDにはInteger型で進捗度が入っています。

Ifの分岐を短くすることは可能でしょうか。。

ozwkさんの回答を参考に修正した後のコードです。

Sub CellSetter()
        For i = 6 To rowsCount
            '作業着手予定日が空ならFor文から抜ける
            If Cells(i, 2).Value = "" Then
                Exit For
            End If
            'B6セルから末端までのデータを一時的に格納する。
            cellDateB = Cells(i, 2).Value
            'C6セルから末端までのデータを一時的に格納する。
            cellDateC = Cells(i, 3).Value
            'D6セルから末端までのデータを一時的に格納する。
            cellDateD = Cells(i, 4).Value
            '①
            If cellDateC < cellDateFrom Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '②
            ElseIf cellDateB < cellDateFrom And cellDateC = cellDateTo Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '③
            ElseIf cellDateB < cellDateFrom And cellDateFrom < cellDateC And cellDateC < cellDateTo Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '④
            ElseIf cellDateFrom = cellDateB And cellDateFrom < cellDateC And cellDateC < cellDateTo Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '⑤
            ElseIf cellDateFrom < cellDateB And cellDateB < cellDateTo And cellDateFrom < cellDateC And cellDateC < cellDateTo Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '⑥
            ElseIf cellDateFrom < cellDateB And cellDateB < cellDateTo And cellDateC = cellDateTo Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '⑦
            ElseIf cellDateFrom < cellDateB And cellDateB < cellDateTo And cellDateTo < cellDateC Then
                Call Selecter(i, cellDateD, C_START, C_END_FIRST, C_START, C_END_EMP, C_START_LATE, C_END_EMP)
            '⑧
            ElseIf cellDateB = cellDateTo And cellDateTo < cellDateC Then
                Call Selecter(i, cellDateD, C_START, C_END_FIRST, C_START, C_END_EMP, C_START_LATE, C_END_EMP)
            '⑨
            ElseIf cellDateTo < cellDateB Then
                Call Selecter(i, cellDateD, C_START_FIRST, C_END_FIRST, C_START_FIRST, C_END_EMP, C_START_EMP, C_END_EMP)
            '⑩
            ElseIf cellDateB < cellDateFrom And cellDateFrom = cellDateC Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '⑪
            ElseIf cellDateB = cellDateFrom And cellDateC = cellDateTo Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '⑫
            ElseIf cellDateB = cellDateFrom And cellDateTo < cellDateC Then
                Call Selecter(i, cellDateD, C_START, C_END_FIRST, C_START, C_END_EMP, C_START_LATE, C_END_EMP)
            '⑬
            ElseIf cellDateB < cellDateFrom And cellDateTo < cellDateC Then
                Call Selecter(i, cellDateD, C_START, C_END_FIRST, C_START, C_END_EMP, C_START_LATE, C_END_EMP)
            '⑭
            ElseIf cellDateB = cellDateFrom And cellDateC = cellDateFrom Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            '⑮
            ElseIf cellDateB = cellDateTo And cellDateC = cellDateTo Then
                Call Selecter(i, cellDateD, C_START, C_END, C_START, C_END_LATE, C_START_LATE, C_END_LATE)
            End If
        Next i
    End Sub
'メソッド名は後で考えます。
Sub Selecter(count As Variant, cellDateD As Integer, str1 As String, str2 As String, str3 As String, str4 As String, str5 As String, str6 As String)
        Select Case cellDateD
            Case 100
                Cells(count, 5).Value = str1
                Cells(count, 6).Value = str2
            Case 1 To 99
                Cells(count, 5).Value = str3
                Cells(count, 6).Value = str4
            Case 0
                Cells(count, 5).Value = str5
                Cells(count, 6).Value = str6
        End Select
    End Sub

追記
どうしてこのような分岐パターンができたのかという画像があったのですが、
イメージの追加ができませんでした。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • King_of_Flies

    2017/09/28 11:26

    ただ、その修正後のプログラムを見てわかると思いますが、分岐パターン15のうち、同じ結果をセットする処理がいくつかあり、これを短くするにはどうすればよいかというとことで、悩んでいます。

    キャンセル

  • momon-ga

    2017/09/28 12:00

    パターンの整理をするとよいかもですね。参考 https://www.slideshare.net/kawasima/ss-26968240

    キャンセル

  • King_of_Flies

    2017/09/28 12:11

    カルーノ図とやらがもしかしたらコードを短くするヒントになるかもしれないですね。少し調べてみます。

    キャンセル

回答 2

checkベストアンサー

0

長いので全然内容読んでませんが、

(Else)If 条件式 Then
  Select Case cellDateD
    Case 100
      Cells(i, 5).Value = 値A
      Cells(i, 6).Value = 値B
    Case 1 To 99
      Cells(i, 5).Value = 値C
      Cells(i, 6).Value = 値D
    Case 0
      Cells(i, 5).Value = 値E
      Cells(i, 6).Value = 値F
  End Select
...

というパターンの繰り返しなので
Select部分をf(i,値A,値B,...,値F)と置けば
単純に

(Else)If 条件式 Then
  f(i,値A,値B, ... ,値F)
(Else)If 条件式 Then
  f(i,値A,値B, ... ,値F)
(Else)If 条件式 Then
  f(i,値A,値B, ... ,値F)
(Else)If 条件式 Then
  f(i,値A,値B, ... ,値F)
...

で、これで少し見やすくなると、
条件式が違うだけでやっていることが同じなところが何箇所も見つかると思います。
それら条件式を論理的にまとめると更に減ります。

例えば3,4は
3:(B < F And F < C And C < T )
4:(F = B And F < C And C < T )
なので
(B <= F And F < C And C < T )にまとまります

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

要件わかってないですが、結果表を作成して、インデックスの取得を関数化すればよいかと。
変数名が全然いけてないので修正ですね。

Sub CellSetter()

    Dim RESULT(1, 2)   'パターン数 × cellDateDの分岐数
    'めんどいのでコピペですが・・・
    RESULT(0, 0) = Array(C_START_EMP, C_END)
    RESULT(0, 1) = Array(C_START, C_LATE)
    RESULT(0, 2) = Array(C_START_TMP, C_END) 
    RESULT(1, 0) = Array(C_START_EMP, C_END)
    RESULT(1, 1) = Array(C_START_EMP, C_END)
    RESULT(1, 2) = Array(C_START_EMP, C_END)
'ここまで、初期設定

    For i = 6 To rowsCount
        hyo_PT = getPT(cellDateB, cellDateC, cellDateFrom, cellDateTo)
        hyo_POS = getPos(cellDateD)

        Cells(i, 5).Value = RESULT(hyo_PT, hyo_POS)(0)
        Cells(i, 6).Value = RESULT(hyo_PT, hyo_POS)(1)
    Next

End Sub

Function getPos(cellDateD)
    Select Case cellDateD
        Case 100
            getPos = 2
        Case 1 To 99
            getPos = 1
        Case 0
            getPos = 0
    End Select
End Function

Function getPT(cellDateB, cellDateC, cellDateFrom, cellDateTo)
'面倒なので実装は書かないですが、意味は伝わるかと・・・
    getPT = 0   '例の日付の大小のif文
End Function

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/09/28 11:35

    一番最初の初期設定のコメントでパターン数*CellDateDの分岐数の宣言をするとのことですが、
    こうなると45パターン書くことになりますね。
    これはちょっと厳しいかもしれないです。

    ただ、GetPosとGetPTの考え方は参考になるものがありました。

    このあたりを自分で考えて組み込んでみるのもありですね!

    しばらくお待ちを。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.76%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

  • 受付中

    VBA 全体の許容値(±2㎜)と前日との差(1㎜)の乱数取得

    いつもお世話になっております。 下記の件に、ついてアドバイスをお願い致します。 ◆計測データ基準値 X:-47665.64500     Y:-8153.4980    z:

  • 解決済

    VBAでアンケート結果を振り分けたい

    前提・実現したいこと excelにてアンケート集計表を作成しています。 入力シートの各行の回答群を違うシートにコピーするVBAを書いていますがうまくいきません。 全シート

  • 解決済

    【VBA】入力をした順番通りに文字が反映されない

    現在業務で使うエクセルの表の分類・入力を楽にするために 「セルG12~G300orI12~I300のどれか一つに『携帯ショップスタッフor本社事務or審査事務』などの求人名を入力

  • 解決済

    時間処理について(比較し含まれている方を消したい)

    前提・実現したいこと 1列の同じ項目内で時間を比較し、時間が含まれているほうの行を消したい 画像の赤枠が残るようにしたい 発生している問題・エラーメッセージ 1行目の目次を比較

  • 解決済

    マクロで条件分岐させる

    VBA  Aの条件で「大」を表示 AからBに条件が変化したときが「中」表示に変化させるVBAを考えています。 下記を参考に考えましたがうまく行きません。どのような方法がBESTがお

  • 解決済

    VBA高速化について

    20個のエクセルファイルを読み込み、特定のシートにあるテーブルから特定の値を探し出し、その右横にあるセルの値を取り出します。 集計用のエクセルのテーブルでも、同じ特定の値をテーブル

  • 解決済

    指定範囲内のセルから数字を含まないセルを削除したい

    VBAを使ってエクセルの指定範囲内のセルから数字を含まないセルを削除したいと考えています。 具体的にはシート名”抽出”のJ列2行目から最終行までで、セル内に0~9の数字が入って

  • 解決済

    VBA 条件分岐 while文?

     VBAで背景色をつけたい。エクセルの範囲を指定せずに、複数の条件分岐を実現したい ここに質問の内容を詳しく書いてください。 かなり長文になると思いますが、色々試した結果、手詰まり

同じタグがついた質問を見る

  • VBA

    1647questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。