Excel (VBA)

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

 
(Windows 7 Professional : Excel 2010)
予定開始日と終了日の組み合わせについて
投稿日時: 18/06/18 01:04:10
投稿者: 河童TKO

いつも大変お世話になっております。
予定計画表を作成中です。
予定計画表は月単位のシートです。

  A       B       C       D       E       F       G       H       I       J       K
1 日付    1    2    3    4    5    6    7    8    9    10
2 区分    始        終        始   終        始        終
3 利用者   赤        赤           赤   赤       赤   赤   赤
4 時刻    9:00      17:00      10:00  20:00      9:00      18:00

※赤:セルを赤色で塗りつぶし
 
計画表の登録内容として
登録1:開始日1日9:00から終了日3日17:00
登録2:開始日5日10:00から終了日6日20:00
登録3:開始日8日9:00から終了日10日18:00
 
エクセルの内容をユーザフォームに表示したいと思っています。
登録1:ラベル
開始日区分1:チェックボックス
開始日1:テキストボックス
開始時刻1:テキストボックス
終了日区分1:チェックボックス
終了日1:テキストボックス
終了時刻1:テキストボックス
登録2:ラベル
開始日区分2:チェックボックス
開始日2:テキストボックス
開始時刻2:テキストボックス
終了日区分2:チェックボックス
終了日2:テキストボックス
終了時刻2:テキストボックス
登録3:ラベル
開始日区分3:チェックボックス
開始日3:テキストボックス
開始時刻3:テキストボックス
終了日区分3:チェックボックス
終了日3:テキストボックス
終了時刻3:テキストボックス
わからないことと教えて欲しいことがあります。
 
わからないことは、
登録1の内容で開始の区分がないとき,どのように
登録内容を組み合わせるか困っています。
必ず最初に開始日の区分があることしか対応できていません。
前月から引き続きの予定の場合、1日が期間中で区分がないときがあります。
そのときの開始日の登録内容の組み合わせがおかしくなります。
最初の登録内容の開始日と終了日をどのようにセットすれば良いでしょうか。
 
フォームの表示(登録1の開始日区分がTrueとなっている)
登録1:
開始日区分1:True
開始日1:1
開始時刻1:10:00
終了日区分1:True
終了日1:3
終了時刻1:17:00
登録2:ラベル
開始日区分2:True
開始日2:5
始時刻2:9:00
終了日区分2:True
終了日2:6
終了時刻2:20:00
登録3:ラベル
開始日区分3:False
開始日3:8
開始時刻3:空白
終了日区分3:False
終了日3:10
終了時刻3:18:0
 
教えてほしいこと
開始日と終了日の組み合わせ方法とフォームへの表示方法のコードの
簡易化です。
今は登録は1から3までしかありませんが、10個までふえたとき、
IF文でつなげるのでコードが長くなります。
コードを読みやすくするにはどのようにすればよいでしょうか?
よろしくお願いいたします。
 
Private Sub CommandButton1_Click()

Dim actCol As Long
Dim actRow As Long
Dim i As Long
Dim 開始日1 As Variant
Dim 開始日2 As Variant
Dim 開始日3 As Variant
Dim 終了日1 As Variant
Dim 終了日2 As Variant
Dim 終了日3 As Variant
Dim 開始時刻1 As Variant
Dim 開始時刻2 As Variant
Dim 開始時刻3 As Variant
Dim 終了時刻1 As Variant
Dim 終了時刻2 As Variant
Dim 終了時刻3 As Variant
Dim 開始日区分1 As Boolean
Dim 開始日区分2 As Boolean
Dim 開始日区分3 As Boolean
Dim 終了日区分1 As Boolean
Dim 終了日区分2 As Boolean
Dim 終了日区分3 As Boolean
Dim actColor As Long
Dim nxtColor As Long
Dim 予定期間中FLG As Boolean
Const 予定日COLOR As Long = 255 '予定日は「赤」

    'アクティブ行列
    actCol = ActiveCell.Column
    actRow = ActiveCell.Row
    
    For i = 1 To 31

        '開始日の区分取得
        If Cells(actRow - 1, actCol + i) = "始" Then
            If 開始日区分1 = False Then
                開始日区分1 = True
            Else
                If 開始日区分2 = False Then
                    開始日区分2 = True
                Else
                    If 開始日区分3 = False Then
                        開始日区分3 = True
                    End If
                End If
            End If
                        
            '開始時刻の取得
            If Cells(actRow + 1, actCol + i) <> "" Then
                If 開始時刻1 = "" Then
                    開始時刻1 = Format(CDate(Cells(actRow + 1, actCol + i)), "h:mm")
                Else
                    If 開始時刻2 = "" Then
                        開始時刻2 = Format(CDate(Cells(actRow + 1, actCol + i)), "h:mm")
                    Else
                        If 開始時刻3 = "" Then
                            開始時刻3 = Format(CDate(Cells(actRow + 1, actCol + i)), "h:mm")
                        End If
                    End If
                End If
            End If
        End If
                        
        '終了日の区分取得
        If Cells(actRow - 1, actCol + i) = "終" Then
            If 終了日区分1 = False Then
                終了日区分1 = True
            Else
                If 終了日区分2 = False Then
                    終了日区分2 = True
                Else
                    If 終了日区分3 = False Then
                        終了日区分3 = True
                    End If
                End If
            End If
            
            '終了時刻の取得
            If Cells(actRow + 1, actCol + i) <> "" Then
                 If 終了時刻1 = "" Then
                     終了時刻1 = Format(CDate(Cells(actRow + 1, actCol + i)), "h:mm")
                 Else
                     If 終了時刻2 = "" Then
                         終了時刻2 = Format(CDate(Cells(actRow + 1, actCol + i)), "h:mm")
                     Else
                         If 終了時刻3 = "" Then
                             終了時刻3 = Format(CDate(Cells(actRow + 1, actCol + i)), "h:mm")
                         End If
                     End If
                 End If
             End If
            
            
        End If
        
        '予定の期間(開始日と終了日)を取得(セルの塗りつぶし)
        actColor = Cells(actRow, actCol + i).Interior.Color     '当日の色
        nxtColor = Cells(actRow, actCol + i + 1).Interior.Color '翌日の色
        If 予定日COLOR = actColor Then
            If 予定期間中FLG = False Then
                If 開始日1 = "" Then
                    開始日1 = i
                Else
                    If 開始日2 = "" Then
                        開始日2 = i
                    Else
                        If 開始日3 = "" Then
                            開始日3 = i
                        End If
                    End If
                End If
                
                予定期間中FLG = True
            
            Else
                '終了日を設定(翌日の色が変わった場合)
                If 予定日COLOR <> nxtColor Then
                    If 終了日1 = "" Then
                        終了日1 = i
                    Else
                        If 終了日2 = "" Then
                            終了日2 = i
                        Else
                            If 終了日3 = "" Then
                                終了日3 = i
                            End If
                        End If
                    End If
            
                    予定期間中FLG = False
                End If
            End If
            
        End If
            
    Next i

    Frm_Touroku.chk開始日1 = 開始日区分1
    Frm_Touroku.txt開始日1 = 開始日1
    Frm_Touroku.txt開始時刻1 = 開始時刻1
    Frm_Touroku.chk終了日1 = 終了日区分1
    Frm_Touroku.txt終了日1 = 終了日1
    Frm_Touroku.txt終了時刻1 = 終了時刻1
    
    Frm_Touroku.chk開始日2 = 開始日区分2
    Frm_Touroku.txt開始日2 = 開始日2
    Frm_Touroku.txt開始時刻2 = 開始時刻2
    Frm_Touroku.chk終了日2 = 終了日区分2
    Frm_Touroku.txt終了日2 = 終了日2
    Frm_Touroku.txt終了時刻2 = 終了時刻2

    Frm_Touroku.chk開始日3 = 開始日区分3
    Frm_Touroku.txt開始日3 = 開始日3
    Frm_Touroku.txt開始時刻3 = 開始時刻3
    Frm_Touroku.chk終了日3 = 終了日区分3
    Frm_Touroku.txt終了日3 = 終了日3
    Frm_Touroku.txt終了時刻3 = 終了時刻3

    Frm_Touroku.Show

End Sub

[/code]

回答
投稿日時: 18/06/18 09:31:08
投稿者: mattuwan44

ども、色で判断されているみたいですが(書いてから気づいた^^;)、
2行目の区分で判断してみました。
 
こういう時は、
初期値を最初、変数に入れておきます。
(例えば1)
で、表を左から見て行って、
「始」が出てきたら、変数の値を上書きすればいいですし、
「終」が出てきたら、出力してしまえばいいです。
あと、テキストボックスのオブジェクト名の最後に番号を振っているなら、
名前+番号でオブジェクト名で出力先を指定すると、
コードが短くなると思います。
 
時間があまりないのでざっくりですが、イメージだけ書いておきます。
参考になれば幸いです。
 
Sub Sample()
    Dim ixCol始 As Long
    Dim ixCol As Long
    Dim rngBody As Range
    Dim i As Long
     
    With ActiveSheet.Range("A1").CurrentRegion
        Set rngBody = Intersect(.Cells, .Offset(, 1))
    End With
     
    ixCol始 = 1
    For ixCol = 1 To rngBody.Columns.Count
        If rngBody(2, ixCol).Value = "始" Then
            ixCol始 = ixCol
        ElseIf rngBody(2, ixCol).Value = "終" Then
            i = i + 1
            With userform1.Controls
                .Item("txtStratDay" & i).Value = rngBody(1, ixCol始).Value
                .Item("txtStratTime" & i).Value = rngBody(4, ixCol始).Value
                .Item("txtEndDay" & i).Value = rngBody(1, ixCol).Value
                .Item("txtEndTime" & i).Value = rngBody(4, ixCol).Value
            End With
        End If
    Next
End Sub

回答
投稿日時: 18/06/18 21:50:09
投稿者: simple

回答ではないので、申し訳ないですが、少し教えてください。
 
ユーザーフォームに情報を書き込むのは何を目的にしているのでしょうか。
今のワークシート上では作業できないことなんでしょうか。
苦労しておられる、その先に何があるのでしょうか。
ワークシート以上の付加価値があるようには、ちょっと思えないのです。
そのあたりの背景となることを教えていただければ、
別のアプローチが提案されるかもしれません。
よろしくお願いします。

投稿日時: 18/06/24 10:30:42
投稿者: 河童TKO

mattuwan44様、simple様 
お返事ありがとうございました。
 
mattuwan44様の方法で
開始区分がないときでも表示することができるようになりました。
 
若干の仕様変更があります。
キャンセル区分の追加・・・セルの色を青色にする
 
もう一つ分からないことができました。
それは月末日で終了区分がないときに
開始から終了の期間が取得できません。
月をまたいで予定がある場合になります。
 
現状のシートでは月末日が30日か31日がわからないようになっています。
わかるようにすれば良いのですが、今の条件のままで処理を考えたいです。
開始区分:True
開始日:28日
終了区分:False
終了日:30日
期間としては翌月まで続いているので、
表示は上記の様にしたいです。
 
期間の条件
1.基本開始区分から終了区分まで
2.開始区分(月初)がないときはセルの色で開始日を判定して
 終了区分まで
3.開始区分から終了区分はなく月末日まで
 
どのようにすれば、条件3のとき
終了区分がないときに期間を取得できるようになりますか?
 
simple様、
計画表の処理の流れとしては、
1.ユーザフォームで開始日等を入力してシートに表示させる登録処理
2.シートに表示されているデータを取得してユーザフォームに表示させる編集登録処理
 
登録処理は完成しているのですが、
編集画面としてユーザフォームを開く時のデータセットが
うまく処理できなくて困っています。
 
今の方法がベストだと思わないのですが、
少しずつバージョンアップできればうれしいです。
 
他のシステムから出力されるデータを読み込んで
予定表作成するとか。
 
 

Private Sub UserForm_Initialize()
Dim ixCol始 As Long
Dim ixCol As Long
Dim actCol As Long
Dim actRow As Long
Dim plnRng As Range
Dim plnCol As Long
Dim plnRow As Long
Dim bCancel As Boolean
Dim addcnt As Integer
    
'アクティブ行列
actCol = ActiveCell.Column
actRow = ActiveCell.Row
    
'利用者の表示
If Cells(actRow, actCol).Value <> "" Then
    lbl利用者 = Cells(actRow, actCol).Value & " 様"
Else
    lbl利用者 = ""
End If
    
'予定表開始位置(利用者の2つ右隣の値を取得)
Set plnRng = ActiveCell.Offset(0, 2)
plnRng.Select
plnCol = ActiveCell.Column  '開始セルの列
plnRow = ActiveCell.Row     '開始セルの行
                
bCancel = False
i = 0
ixCol始 = 0
For ixCol = 1 To 31    
    If ixCol始 = 0 Then
        'セルの色が赤色の場合
        If Cells(plnRow + 1, plnCol + ixCol - 1).Interior.Color = YOTEI_COLOR1 Then
            ixCol始 = ixCol
            bCancel = False
        'セルの色が青色の場合
        ElseIf Cells(plnRow + 1, plnCol + ixCol - 1).Interior.Color = YOTEI_COLOR2 Then
            ixCol始 = ixCol
            bCancel = True
        'その他
        Else
            ixCol始 = 0
            bCancel = False
        End If
    End If
        
    '退出のときに各コントロールに値をセット
    If Cells(plnRow, plnCol + ixCol - 1).Value = "退" Or _
        Cells(plnRow, plnCol + ixCol - 1).Value = "入退" Or _
        Cells(plnRow, plnCol + ixCol - 1).Value = "退家" Then
        i = i + 1
        With Frm_Touroku.Controls
                
            '開始区分
            If Cells(plnRow, plnCol + ixCol始 - 1).Value = "入" Then
                .Item("chkStrkbn" & i).Value = True
            Else
                .Item("chkStrkbn" & i).Value = False
            End If
            '開始日
            .Item("cboStrDay" & i).Value = ixCol始
            '開始時刻
            If Cells(plnRow + 2, plnCol + ixCol始 - 1).Value <> "" Then
                .Item("txtStrJikoku" & i).Value = Format(CDate(Cells(plnRow + 2, plnCol + ixCol始 - 1).Value), "h:mm")
            End If
                
            '終了区分
            If Cells(plnRow, plnCol + ixCol - 1).Value = "退" Then
                .Item("chkEndkbn" & i).Value = True
            ElseIf Cells(plnRow, plnCol + ixCol - 1).Value = "退家" Then
                .Item("chkEndkbn" & i).Value = True
                .Item("chkKazoku" & i).Value = True
            Else
                .Item("chkEndkbn" & i).Value = False
            End If
            '終了日
            .Item("cboEndDay" & i).Value = ixCol
                
            '終了時刻
            If Cells(plnRow, plnCol + ixCol - 1).Value <> "" Then
                .Item("txtEndJikoku" & i).Value = Format(CDate(Cells(plnRow + 2, plnCol + ixCol - 1).Value), "h:mm")
            End If
                
            'キャンセル
            .Item("chkCancel" & i).Value = bCancel
                
        End With
            
        ixCol始 = 0
            
    End If
Next
        
Cells(actRow, actCol).Select
    
End Sub
[/code]

回答
投稿日時: 18/06/25 07:13:24
投稿者: simple

いくつかコメントします。
 
1.
> 現状のシートでは月末日が30日か31日がわからないようになっています。
> わかるようにすれば良いのですが、今の条件のままで処理を考えたいです。

   月情報を持つのが自然だと思います。
   Date型の(つまり年月日がある)日付にしておいて、
   表示を日だけにすれば済む話です。
 
2.ワークシート上で横に連続させれば、月末を意識することもないはず。
   経過した月や、今後の月は非表示にすればよいだけでしょう。
   それに翌月以降の予定も入れることもあるでしょう。
 
3. どうしても月ごとに区切りたいなら、
   (1)「継続」という区分をつけて、月末・月初にそれを振るか、または、
   (2)予め「始」で始まるか、「終」で始まるかを判定するほかないでしょう。
      ・「終」で始まっていたら継続と見なす、
      ・月末も「始」で終わっていれば継続判定する
      という判断をさせればよい。
 
わざわざ無理な仕様にしているように見受けます。
全体として、コードでつじつまを合わせようとするより、
仕様を整備するのが先ではないかというのが感想です。
 
# 私は、実は、なぜユーザーフォームなのかまだ理解できていません。
# ワークシート上で色を使って、
# ガントチャートのようなものを使う方向で考えた方がよいと思っています。

回答
投稿日時: 18/06/25 10:29:04
投稿者: mattuwan44

>期間としては翌月まで続いているので、
>表示は上記の様にしたいです。

考え方は最大がその月の最後の日ということですね。
 
言い換えると、「次の月の1日の前日」です。
 

Sub test()
    MsgBox DateSerial(Year(Date), Month(Date) + 1, 1) - 1
End Sub

投稿日時: 18/06/25 11:20:48
投稿者: 河童TKO

simple様、mattuwan44様
お返事ありがとうございます。
 
確かに使いやすいように仕様を整備した方が良いですね。
日付の情報がなければ、追加した方が早い。
 
1シートに1カ月分なのか
1シートに1年分なのかどちらが使いやすく、作りやすいか検討します。
1年分だと当月のみの印刷出力が難しそう。
 
月をまたぐときは、月末日に「継」を表示させようと思います。
 
ユーザーフォームで入力された値をもとにして
ワークシート上にガンチャートのようなものは作成しています。
作成後に変更があったとき、ワークシートのガンチャートを
直接変更するのではなく、ユーザーフォーム上で変更しようと思っていました。
 
月末日の取得方法を使用して
条件に追加してみたいと思います。
 
アドバイスをもとに
計画表のバージョンアップを進めていきます。
ありがとうございました。
また不明点ができたときは、よろしくお願いします。