Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10891 / 13644 ツリー ←次へ | 前へ→

【19171】シートの値をtextboxへ取り込みたいので... ponpon 04/10/24(日) 15:33 質問[未読]
【19176】Re:シートの値をtextboxへ取り込みたいので... こもれび 04/10/24(日) 17:40 回答[未読]
【19179】Re:シートの値をtextboxへ取り込みたいの... ponpon 04/10/24(日) 18:21 質問[未読]
【19180】Re:シートの値をtextboxへ取り込みたいの... kobasan 04/10/24(日) 20:38 発言[未読]
【19181】Re:シートの値をtextboxへ取り込みたいの... かみちゃん 04/10/24(日) 20:58 発言[未読]
【19184】Re:シートの値をtextboxへ取り込みたいの... ponpon 04/10/24(日) 21:31 発言[未読]
【19182】Re:シートの値をtextboxへ取り込みたいの... ponpon 04/10/24(日) 21:18 質問[未読]
【19218】Re:シートの値をtextboxへ取り込みたいの... kobasan 04/10/25(月) 20:40 発言[未読]
【19220】Re:シートの値をtextboxへ取り込みたいの... ponpon 04/10/25(月) 21:14 お礼[未読]
【19183】Re:シートの値をtextboxへ取り込みたいので... Hirofumi 04/10/24(日) 21:25 回答[未読]
【19186】Re:シートの値をtextboxへ取り込みたいので... ponpon 04/10/24(日) 21:49 発言[未読]
【19187】不都合が有るみたいなので修正します Hirofumi 04/10/24(日) 21:51 回答[未読]
【19191】Re:不都合が有るみたいなので修正します ponpon 04/10/24(日) 22:42 発言[未読]
【19221】Re:不都合が有るみたいなので修正します Hirofumi 04/10/25(月) 22:13 発言[未読]
【19261】よろしくお願いします。 ponpon 04/10/26(火) 18:25 発言[未読]
【19305】ここまでは考えたのですが・・・. ponpon 04/10/27(水) 20:58 質問[未読]
【19307】Re:ここまでは考えたのですが・・・. Hirofumi 04/10/27(水) 21:19 発言[未読]
【19308】Re:ここまでは考えたのですが・・・. ponpon 04/10/27(水) 21:38 発言[未読]
【19309】Re:ここまでは考えたのですが・・・. Hirofumi 04/10/27(水) 22:05 回答[未読]
【19310】Re:ここまでは考えたのですが・・・. ponpon 04/10/27(水) 23:25 お礼[未読]
【19348】Re:ここまでは考えたのですが・・・. Hirofumi 04/10/28(木) 20:15 回答[未読]
【19349】Re:ここまでは考えたのですが・・・. ponpon 04/10/28(木) 21:15 お礼[未読]

【19171】シートの値をtextboxへ取り込みたいので...
質問  ponpon  - 04/10/24(日) 15:33 -

引用なし
パスワード
   こんにちは。
またまたお世話になります。
下記のように時間割シートに

A B  C  D  E  F  G  H  I J
1   4/1 4/2 4/3 4/4 4/5 4/6 4/7 4/8 ・・・・
2   金  土 日 月 火 水 木 金  ・・・・
3 1 国      国 算 国 算 国  ・・・・
4 2 算      算 国 算 国 算  ・・・・
5 3 社      社 音 理 体 社  ・・・・
6 4 理      理 体 社 家 理  ・・・・
7 5 体      体 家 総 国 体  ・・・・
8 6 音      音 総 ク 音     ・・・・
9 
10   5/1 5/2 5/3 5/4 5/5 5/6 5/7  ・ ・  ・  ・  
11 1 日  月 火 水 木 金  土
12 2
13 3
 
 これを
 ユーザーホームに取り込みたいと考えています。
ユーザーホームに
   スピンボタン2つ(月と週の変更) 
   テキストボックス2つ(月と週の表示)
   ラベルを横に5つ(日付表示用)
   その下にテキストボックスを5列6行の30個(各時間割表示)
   コマンドボタン3つ
    (時間割表示用、更新用、閉じる)
を配置し、
 スピンボタンで、月と週を選び、表示ボタンをクリックすると、
 その週の時間割を表示し、変更をして、更新ボタンをクリックすると、
 変更した内容が、シートに反映されるという仕組みを作りたいと考えているのですが、
  シートは毎年使うため、年によって始まる曜日が違います。
 土日を除いて月曜から始まるときから、火、水、・・の場合を考え、第一週のラベルを表示させることはできました。後オフセットして下の時間割を取得してテキストボックスに表示させることに挑戦していますが、考え方がまずいのか膨大な量のコードに成ります。
 また、汎用性がなく、すべて一つ一つコードを書いていかなければ成りません。
 何とかうまく取得して更新する方法は、ないものでしょうか?
 よろしくお願いします。

Private Sub CommandButton4_Click()
  Dim SPN_x As Integer
  Dim SPN_y As Integer
  Dim myTxt As MSForms.TextBox
  Dim mylbl As MSForms.Label
 
  SPN_x = SpinButton1.Value
  SPN_y = SpinButton2.Value

  Select Case SPN_x

   Case 4  ’4月の時
    For p = 1 To 5   
     Select Case SPN_y
      Case p    '第p週

     SHMD = Worksheets("sheet1").Cells(2, 2).Value
      Select Case SHMD
      Case 2   ’月曜から始まるときは
       For j = 1 To 5
       Set mylbl = Form時間割確定.Controls("Label" & j)
         mylbl.Caption = Format(Worksheets("sheet1").Cells _
                        (1, j + 1).Value, "m/d")
       Next j
       For i = 1 To 6
        Set myTxt = Form時間割確定.Controls("TextBox" & i)
         myTxt.Value = Worksheets("sheet1").Cells(1, j + 1) _
                        .Offset(i + 1, -5).Value
       Next i
      
      Case 3   ’火曜から始まるときは
       For j = 2 To 5
       Set mylbl = Form時間割確定.Controls("Label" & j)
         mylbl.Caption = Format(Worksheets("sheet1").Cells _
                           (1, j).Value, "m/d")
       Next j

      Case 4    ’水曜から始まるときは
       For j = 3 To 5
       Set mylbl = Form時間割確定.Controls("Label" & j)
         mylbl.Caption = Format(Worksheets("sheet1").Cells _
                         (1, j - 1).Value, "m/d")
       Next j

      Case 5   ’木曜から始まるときは
       For j = 4 To 5
       Set mylbl = Form時間割確定.Controls("Label" & j)
         mylbl.Caption = Format(Worksheets("sheet1").Cells _
                       (1, j - 2).Value, "m/d")

       For i = 1 To 6
        Set myTxt = Form時間割確定.Controls("TextBox" & i + 18)
         myTxt.Value = Worksheets("sheet1").Cells(1, j - 2) _
                       .Offset(i + 1, -1).Value
       Next i
      
       For i = 7 To 12
        Set myTxt = Form時間割確定.Controls("TextBox" & i + 18)
         myTxt.Value = Worksheets("sheet1").Cells(1, j - 2) _
                        .Offset(i - 5, 0).Value
       Next i
       Next j
     

      Case 6   ’金曜から始まるときは
       For j = 5 To 5
       Set mylbl = Form時間割確定.Controls("Label" & j)
         mylbl.Caption = Format(Worksheets("sheet1").Cells _
                       (1, j - 3).Value, "m/d")
       Next j

    End Select

    End Select
    Next p
 
 End Select


End Sub

【19176】Re:シートの値をtextboxへ取り込みたいの...
回答  こもれび E-MAIL  - 04/10/24(日) 17:40 -

引用なし
パスワード
   こもれびです

>  シートは毎年使うため、年によって始まる曜日が違います。
> 土日を除いて月曜から始まるときから、火、水、・・の場合を考え、第一週のラベルを表示させることはできました。後オフセットして下の時間割を取得してテキストボックスに表示させることに挑戦していますが、考え方がまずいのか膨大な量のコードに成ります。

「Weekday関数」を用いますと日付から曜日を示すバリアント型 (内部処理形式 Integer の Variant) の値を得ることができますので、オフセット操作
を行わなくてもよくなると思います。
詳しくはWeekday関数のヘルプを参照願います。

【19179】Re:シートの値をtextboxへ取り込みたいの...
質問  ponpon  - 04/10/24(日) 18:21 -

引用なし
パスワード
   ▼こもれび さん:
>
>「Weekday関数」を用いますと日付から曜日を示すバリアント型 (内部処理形式 Integer の Variant) の値を得ることができますので、オフセット操作
>を行わなくてもよくなると思います。
>詳しくはWeekday関数のヘルプを参照願います。

早速の返信ありがとうございます。
 ヘルプを見てみました。が今一よくわかりません。
 シートの曜日の欄はWeekday関数を用いて表示を「aaa」としています。
そこでコードでは 曜日の欄(SHMD)の値で分岐、処理しました。そこまではできたのですが、その下の時間割をテキストボックスに表示するところで困っています。
 ロジックが思い浮かばないのです。今やっていることは、今年だと木曜日からですので
SHMDは5になります。
 そこでシートの月日から2つオフセットした値をTxt1に、3つオフセットさせた値を
Txt2に・・・・とやっています。
 しかし、この方法では、Txt1〜Txt6、Txt7〜Txt12、・・・・・というように場合分けをしなければ成らなくなり、膨大なコードになってしまいます。
これを5月6月・・・3がつまで
しかも第2週以降もまだ考えていません。
 というような状況です。
 もし、こもれびさんの指摘したことでなければ申し訳ありません。
 Weekday関数を使ったロジックを思い浮かべることができません。
 もう少し解説していただけないでしょうか。 

【19180】Re:シートの値をtextboxへ取り込みたいの...
発言  kobasan  - 04/10/24(日) 20:38 -

引用なし
パスワード
   ponpon さん 今晩は
Weekdayを使って、曜日を求めるコードです
Sub test()
Dim MyDate, MyWeekDay
Dim a As Variant
  a = Array("", "日", "月", "火", "水", "木", "金", "土")
  'MyDate = #10/25/2004#     '#月/日/年# 日付を代入
  '        月      /      日      /     年
  MyDate = Cells(2, 2).Value & "/" & Cells(2, 3).Value & "/" & Cells(2, 1)
  MyWeekDay = Weekday(MyDate)
  ' MyDate が木曜日を表すとき、MyWeekDay には、4 が代入されます
  MsgBox a(MyWeekDay)
End Sub
使えたら、検討してみてください。

【19181】Re:シートの値をtextboxへ取り込みたいの...
発言  かみちゃん  - 04/10/24(日) 20:58 -

引用なし
パスワード
   ponpon さん、kobasan さん こんにちは。かみちゃん です。

>Weekdayを使って、曜日を求めるコードです

そういう意味でしたら、渡しなら、次の1行て処理してしまいます。
  MsgBox Choose(Weekday(MyDate), "日", "月", "火", "水", "木", "金", "土")
または
  MsgBox Format(MyDate, "aaa")
です。

さきほどから、ponponさんの課題を眺めていますが、何がしたいのか要件が見えてきません。
時間割って、そもそも日毎にかわるのかな?少なくとも学期単位とかで変わるものではないのか?といろいろ考えてしまっています。
名案が浮かんだら、また書きます。

【19182】Re:シートの値をtextboxへ取り込みたいの...
質問  ponpon  - 04/10/24(日) 21:18 -

引用なし
パスワード
   ▼kobasan さん:

返信ありがとうございます。

 どう答えてよいのかわからないのですが、WeekDay関数については、前にも使ったことがあるので、少しはわかります。
arryの配列は0から始まるので一番最初に""を入れるということですよね。
従って、1−日、2−月、3−火、4−水、5−木、6−金、7−土となるのですよね。
これを使ってラベルの月日にについては出力することはできました。
 悩んでいるのは、その後のテキストボックスに時間割を表示するところです。
 ここが、わかりません。
 テキストボックスは1列に6個txt1〜txt6、2列目にtxt7からtxt12・・・と6行5列並んでいます。
 Weekday関数を使ってラベルのlbl1〜lbl5の月日表示は何とかなりそうなのですが、
その後のテキストボックスに時間割をどのように表示させたらよいか。アイデアを教えていただきたいのですが・・・。
 
 今やっていることは、今年だと木曜日からですので
 SHMDは5になります。
 そこでシートの月日から2つオフセットした値をTxt1に、3つオフセットさせた値を
 Txt2に・・・・とやっています。
 しかし、この方法では、Txt1〜Txt6、Txt7〜Txt12、・・・・・というように場合分け をしなければ成らなくなり、膨大なコードになってしまいます 
 
 すみません。初心者なので間違ったとらえ方をしているのかもしれません。
 よろしくお願いします。 
 

>ponpon さん 今晩は
>Weekdayを使って、曜日を求めるコードです
>Sub test()
>Dim MyDate, MyWeekDay
>Dim a As Variant
>  a = Array("", "日", "月", "火", "水", "木", "金", "土")
>  'MyDate = #10/25/2004#     '#月/日/年# 日付を代入
>  '        月      /      日      /     年
>  MyDate = Cells(2, 2).Value & "/" & Cells(2, 3).Value & "/" & Cells(2, 1)
>  MyWeekDay = Weekday(MyDate)
>  ' MyDate が木曜日を表すとき、MyWeekDay には、4 が代入されます
>  MsgBox a(MyWeekDay)
>End Sub
>使えたら、検討してみてください。

【19183】Re:シートの値をtextboxへ取り込みたいの...
回答  Hirofumi  - 04/10/24(日) 21:25 -

引用なし
パスワード
   如何、回答したら善いか善く解らないので
試しに作って見ました
ただ、TextBoxとスピンボタンの組み合わせは、ComboBoxにして有ります

シートのカレンダーは、以下のコードで作成されるカレンダーを使う物と想定しています
尚、「Sub CreateCalendar」のrngListTopで設定されるセル位置と
UserFormの「Sub UserForm_Initialize」のrngListTopで設定されるセル位置を同じにして下さい
rngListTopで設定されるセル位置を替えれば、表の位置は自由に変更できます

Option Explicit

Public Sub CreateCalendar()

  Dim i As Long
  Dim j As Long
  Dim rngListTop As Range
  Dim vntYear As Variant
  Dim lngMonth As Long
  Dim lngDay As Long
  Dim vntCale As Variant
  Dim lngRow As Long
  Dim lngTime(1 To 6, 1 To 1) As Long
  Dim wkstmp As Worksheet
  
  vntYear = Application.InputBox(Prompt:="作成するカレンダの年を入力して下さい", _
                  Title:="カレンダ作成", Default:=Year(Date) + 1, _
                  Type:=2)
  If VarType(vntYear) = vbBoolean Then
    Exit Sub
  End If
  
  'カレンダーの4月1日のセル位置
  Set rngListTop = ActiveSheet.Cells(1, "B")
  For i = 1 To 6
    lngTime(i, 1) = i
  Next i
  lngRow = 0
  For i = 0 To 11
    lngMonth = (i + 4)
    lngDay = Day(DateSerial(vntYear, lngMonth + 1, 0))
    ReDim vntCale(1 To 2, 1 To lngDay)
    For j = 1 To lngDay
      vntCale(1, j) = DateSerial(vntYear, lngMonth, j)
      vntCale(2, j) = Choose((vntCale(1, j) - 1) Mod 7 + 1, "日", _
                      " 月", "火", "水", "木", "金", "土")
    Next j
    With rngListTop.Offset(lngRow)
      .Resize(2, lngDay).Value = vntCale
      .Resize(, lngDay).NumberFormat = "m/d"
      .Offset(2, -1).Resize(6).Value = lngTime
      For j = 0 To lngDay - 1
        Select Case (.Offset(, j).Value - 1) Mod 7 + 1
          Case 1
            .Offset(1, j).Interior.ColorIndex = 38
          Case 7
            .Offset(1, j).Interior.ColorIndex = 36
        End Select
      Next j
    End With
    lngRow = lngRow + 9
  Next i
  
  Set rngListTop = Nothing
  
  Beep
  MsgBox "処理が完了しました"
  
End Sub

UserFormのコントロール
ComboBox1 :月表示用
ComboBox2 :週表示用
Label2〜6 :日付表示用
TextBox21〜26 :月曜1〜6時限表示
TextBox31〜36 :火曜1〜6時限表示
TextBox41〜46 :水曜1〜6時限表示
TextBox51〜56 :木曜1〜6時限表示
TextBox61〜66 :金曜1〜6時限表示
CommandButton1  :時間割表示
CommandButton2  :更新
CommandButton1  :閉じる
で作って有ります

以下をUserFormのコードモジュールに記述して下さい

Option Explicit

Private rngListTop As Range
Private dtmCurrent As Date

Private Sub ComboBox1_Change()

  Dim i As Long
  Dim lngWeek As Long
  
  lngWeek = GetWeekNumb(DateValue(ComboBox1.Value & "1日"))
  With ComboBox2
    .Clear
    For i = 1 To lngWeek
      .AddItem i & "週"
    Next i
    .ListIndex = 0
  End With

End Sub

Private Sub CommandButton1_Click()

  If ComboBox1.ListIndex <> -1 _
      And ComboBox2.ListIndex <> -1 Then
    dtmCurrent = GetWeekDay(CDate(ComboBox1.Value & "1日"), _
                      Val(ComboBox2.Value))
    DataRead
  End If
  
End Sub

Private Sub CommandButton2_Click()

  DataPut
  
End Sub

Private Sub CommandButton3_Click()

  Unload Me
  
End Sub

Private Sub UserForm_Initialize()

  Dim i As Long
  Dim lngYear As Long
  
  'カレンダーの4月1日のセル位置
  Set rngListTop = ActiveSheet.Cells(1, "B")
  With rngListTop
    If IsDate(.Value) Then
      lngYear = Year(.Value)
    Else
      lngYear = Year(Date)
    End If
  End With
      
  With ComboBox1
    .Style = fmStyleDropDownList
    For i = 0 To 11
      .AddItem (lngYear + (i + 3) \ 12) & "年" _
              & (((i + 3) Mod 12) + 1) & "月"
    Next i
  End With
  With ComboBox2
    .Style = fmStyleDropDownList
  End With
  
End Sub

Private Sub UserForm_Terminate()

  Set rngListTop = Nothing
  
End Sub

Private Function GetWeekNumb(dtmMonth As Date) As Long

  Dim i As Long
  Dim dtmTop As Date
  Dim dtmEnd As Date
  
  dtmTop = dtmMonth - ((dtmMonth - 1) Mod 7)
  dtmEnd = DateAdd("m", 1, dtmMonth)
  
  GetWeekNumb = -Int(-(dtmEnd - dtmTop) / 7)
  
End Function

Private Function GetWeekDay(dtmMonth As Date, lngWeek As Long) As Date

  Dim i As Long
  Dim dtmTop As Date
  Dim dtmEnd As Date
  
  If lngWeek = 1 Then
    GetWeekDay = dtmMonth
  Else
    dtmTop = dtmMonth - ((dtmMonth - 1) Mod 7)
    GetWeekDay = DateAdd("ww", lngWeek - 1, dtmTop) + 1
  End If
  
  
End Function

Private Sub DataRead()

  Dim i As Long
  Dim j As Long
  Dim lngRow As Long
  Dim lngCol As Long
  Dim dtmTop As Date
  
  dtmTop = dtmCurrent - ((dtmCurrent - 1) Mod 7)
  lngCol = Day(dtmCurrent) - 1
  lngRow = ((Month(dtmCurrent) + 8) Mod 12) * 9 + 2
  rngListTop.Offset(lngRow - 2, lngCol).Select
  For i = 2 To 6
    If Month(dtmTop + i - 1) = Month(dtmCurrent) Then
      Controls("Label" & i).Caption = Format(dtmTop + i - 1, "m/d(aaa)")
      For j = 1 To 6
        Controls("TextBox" & i & j).Text _
            = rngListTop.Offset(lngRow + j - 1, lngCol).Value
      Next j
      lngCol = lngCol + 1
    Else
      Controls("Label" & i).Caption = ""
      For j = 1 To 6
        Controls("TextBox" & i & j).Text = ""
      Next j
    End If
  Next i
  
End Sub

Public Sub DataPut()

  Dim i As Long
  Dim j As Long
  Dim lngRow As Long
  Dim lngCol As Long
  Dim dtmTop As Date
  
  dtmTop = dtmCurrent - ((dtmCurrent - 1) Mod 7)
  lngCol = Day(dtmCurrent) - 1
  lngRow = ((Month(dtmCurrent) + 8) Mod 12) * 9 + 2
  rngListTop.Offset(lngRow - 2, lngCol).Select
  For i = 2 To 6
    If Month(dtmTop + i - 1) = Month(dtmCurrent) Then
      For j = 1 To 6
        rngListTop.Offset(lngRow + j - 1, lngCol).Value _
                  = Controls("TextBox" & i & j).Text
      Next j
      lngCol = lngCol + 1
    End If
  Next i
  
End Sub

【19184】Re:シートの値をtextboxへ取り込みたいの...
発言  ponpon  - 04/10/24(日) 21:31 -

引用なし
パスワード
   ▼かみちゃん さん:

 返信ありがとうございます。
 何がしたいかもう一度説明します。
 かみちゃん さんがおっしゃるように、時間割は、学期または通年で作成します。
 それの自動化は、ここの掲示板を通して、作り上げることができました。
 しかし、それはあくまでも計画段階での時間割です。
 現実には、先日の台風のように急に休みになったりします。社会見学や遠足が天気の具合で変更になったり、担任の出張で時間割の変更をすることもあります。
  そこで、実際に行った実績を月ごとや学期ごとに提出し、各教科のすすみ具合を点検しているのです。
  今までは、シートに直接、変更分を”国”とか”学”とか入力してもらっていました。
 しかし、シート上に入力するのはいささかわずらわしいと思い、ユーザーホームで、好きな月の週を呼び出して、変更 更新ができるようにと考えた次第です。
 このような説明で、わかっていただけましたでしょうか?
  
>さきほどから、ponponさんの課題を眺めていますが、何がしたいのか要件が見えてきません。
>時間割って、そもそも日毎にかわるのかな?少なくとも学期単位とかで変わるものではないのか?といろいろ考えてしまっています。
>名案が浮かんだら、また書きます。

【19186】Re:シートの値をtextboxへ取り込みたいの...
発言  ponpon  - 04/10/24(日) 21:49 -

引用なし
パスワード
   ありがとうございます。
今から試してみます。
しばらくお待ちください。
やりたいことにつきましては、かみちゃんさんへの
返信に回答しています。
 すみません、遊び人の娘を今から駅へ迎えに行くので、返信が遅くなると思います。m(・・)m

【19187】不都合が有るみたいなので修正します
回答  Hirofumi  - 04/10/24(日) 21:51 -

引用なし
パスワード
   現状では、必ず「時間割表示」をしてからで無いと入力できないので
以下の部分を修正と追加してください

Private Sub ComboBox1_Change()

  Dim i As Long
  Dim lngWeek As Long
  
  lngWeek = GetWeekNumb(DateValue(ComboBox1.Value & "1日"))
  With ComboBox2
    .Clear
    For i = 1 To lngWeek
      .AddItem i & "週"
    Next i
    .ListIndex = 0
  End With
  If ComboBox1.ListIndex <> -1 _
      And ComboBox2.ListIndex <> -1 Then
    dtmCurrent = GetWeekDay(CDate(ComboBox1.Value & "1日"), _
                      Val(ComboBox2.Value))
    DataRead
  End If

End Sub

Private Sub ComboBox2_Change()
  
  If ComboBox1.ListIndex <> -1 _
      And ComboBox2.ListIndex <> -1 Then
    dtmCurrent = GetWeekDay(CDate(ComboBox1.Value & "1日"), _
                      Val(ComboBox2.Value))
    DataRead
  End If

End Sub

この場合、「時間割表示」ボタンは要らなくなるかも?

【19191】Re:不都合が有るみたいなので修正します
発言  ponpon  - 04/10/24(日) 22:42 -

引用なし
パスワード
   ▼Hirofumi さん:
 >この場合、「時間割表示」ボタンは要らなくなるかも?

 確かにいりません。ですね。 

  すばらしいの一言に尽きます。私の考えていたとおりのものです。
 シートにせっせと書いていき、何とか作り上げるのに昨年夏休みに1週間以上かけて作ったものが、一瞬のうちにできるとは・・・・。
 しかし、私の作った年時間割は、学期ごとに変更のものです。その他いろいろと必要なものがたくさんがあります。
 たとえば、1・2年だったら6時間目はないとか、任意の日に「行」(行事)とか
「欠」とかを入れるとか。ほかにも、ほかにも・・・(何か悲しくなってきた)
 
 このまま Hirofumi さんのものを使うわけにはいきませんし、今までのものに組み込むことができません。(すごいんだけどなー)
 
 ありがとうございました。しかし、このままでは、使うことができませんので
 厚かましいお願いですが、ユーザーホームに書くコードの解説(コメント)や考え方を 教えていただけないでしょうか?
 いつまでも初心者なものですから、結構詳しく解説していただくとありがたいのですが・・・  お願いします。  

 それを見て、自分なりに勉強してみようと思います。
 そして、またわからないところは、質問したいと思います。
 別な形式での年間時間割については、自分でも考えて、をいろいろ試行錯誤して同じように表示・更新するユーザーホームを作ることができたのですが、
 この形式では、知識不足で全く思いつかず、冗長なコードになってしまい、助けを求めてしまった訳です。

【19218】Re:シートの値をtextboxへ取り込みたいの...
発言  kobasan  - 04/10/25(月) 20:40 -

引用なし
パスワード
   ponponさん 今晩は

>その後のテキストボックスに時間割をどのように表示させたらよいか。アイデアを教えていただきたいのですが・・・。

提示された表形式ではないのですが、
楽に作るために、次のように、週単位で集計してみては、どうですか。
    月1 月2 月3 月4 月5 〜 金1 金2 金3 金4 金5 金6
4月 1週                   国語 社会 算数 生活 総合 道徳
4月 2週    国語 社会     算数 生活 総合 〜     国語 社会 算数 生活 総合 道徳
4月 3週    国語 社会 算数 生活 総合 〜     国語 社会 算数 生活 総合 道徳
4月 4週    国語 社会     算数 生活 総合 〜     国語 社会 算数 生活 総合 道徳
    〜
7月 14週
7月 15週
7月 16週

そうすると、次のような楽なコードでできます。

Private Sub CommandButton1_Click()
  gyou = 6  'シートに書き込みする行
  For i = 1 To 30
    Cells(gyou, 2 + i) = Controls("textbox" & i).Value
  Next i
End Sub

Private Sub CommandButton2_Click()
  gyou = 6  'フォームに読み込むシートの行
  For i = 1 To 30
    Controls("textbox" & i).Value = Cells(gyou, 2 + i).Value
  Next i
End Sub

書き込み行のコードは、自分でを考えてみて下さい。

検討してみて下さい。

【19220】Re:シートの値をtextboxへ取り込みたいの...
お礼  ponpon  - 04/10/25(月) 21:14 -

引用なし
パスワード
   ▼kobasan さん:
>ponponさん 今晩は
 今晩は
 なるほど ですね
 このようにするとループが簡単なり、テキストボックスに書き込むのが楽になりますね。
 しかし、申し訳ないのですが、すでに形式はできあがっていて、期日指定で夏休み冬休みなどの季休日、および祝祭日から振り替え休日まで自動で入力できるように設定しています。
 これを kobasan さんから提示していただいたように作業シートに書き出し、また、時間割シートに反映させるのは、ちょっと考えてしまいます。今の形式でいろいろと試行錯誤してどうしてもということであれば、検討させていただきます。
 せっかくアイデアを提示していただいたのに気分を悪くしないでください。
 
 今、Hirofumiさんから提示していただいたコードを解析しているところですが、実力不足でわからないところがたくさんあります。ただTxt21〜Txt26、Txt31〜Txt36・・・として、Controls("TextBox" & i & j).Textとループさせる方法とか、その月のトップの日を決めてそこを基点として考える方法など参考になることがたくさんありました。
 ただ、このTextBoxはクラスモジュールでイベントの疑似コントロール化をはかっていますので、Controls("TextBox" & i & j)のようにした場合うまくイベントを取得できるかが心配ですが、何とかやってみようと考えています。
 ありがとうございました。m(__)m
 また、何か気づいたことがありましたらよろしくお願いします。

【19221】Re:不都合が有るみたいなので修正します
発言  Hirofumi  - 04/10/25(月) 22:13 -

引用なし
パスワード
   > ありがとうございました。しかし、このままでは、使うことができませんので
> 厚かましいお願いですが、ユーザーホームに書くコードの解説(コメント)や考え方を 教えていただけないでしょうか?
> いつまでも初心者なものですから、結構詳しく解説していただくとありがたいのですが・・・  お願いします。  
>
> それを見て、自分なりに勉強してみようと思います。
> そして、またわからないところは、質問したいと思います。
> 別な形式での年間時間割については、自分でも考えて、をいろいろ試行錯誤して同じように表示・更新するユーザーホームを作ることができたのですが、
> この形式では、知識不足で全く思いつかず、冗長なコードになってしまい、助けを求めてしまった訳です。

余りやっている時間が無いので、少し(2〜3日)時間を下さい

【19261】よろしくお願いします。
発言  ponpon  - 04/10/26(火) 18:25 -

引用なし
パスワード
   ▼Hirofumi さん:
>余りやっている時間が無いので、少し(2〜3日)時間を下さい
 自分でわかるところは、自分なりにやってはいるのですが、考え方がわからないために
数式の意味がわからないところがたくさんあります。
 たとえば、lngRow = ((Month(dtmCurrent) + 8) Mod 12) * 9 + 2のようなところなど いろいろです。また、Controls("TextBox" & i & j)こんなことなんか思いもよりませんでした。
 いつまででも待ちますので、考え方などを提示していただくとありがたいと思います。
 よろしくお願いします。

【19305】ここまでは考えたのですが・・・.
質問  ponpon  - 04/10/27(水) 20:58 -

引用なし
パスワード
   Humihiroのコードは、解説を待つとして、こんな考え方でやっています。
 まだ全部はできていないのですが、・・・ようやくテキストボックスに一週間分書き出すことができました。

 1 各月の1日のセルを探す。
 2 1日の曜日を判定して、金曜日までの時間割を配列に格納。
 3 テキストボックスに書き出す。
 4 月曜日を取得して、第?月曜日 ←ここがわからない。
 5 その日から金曜日までのセルの値を配列に格納
 6 テキストボックスに書き出す。第?+週。

以下、月から金までの時間割を取得して、テキストボックスに書き出すコードです。
2次元配列ははじめてつかいました。

  Private Sub UserForm_Initialize()
Dim myTxt As MSForms.Textbox
Dim myArray() As Variant
Dim myRng As Range

        ’1行目 日付
        ’2行目 曜日(weekday)関数により
        'シート2のB3〜F8まで時間割があるとして
         
 Set GETU = Worksheets("Sheet2").Range("B2")
If GETU.Value = 2 Then
 
  Set myRng = GETU.Offset(1).Resize(6, 5)
    myArray = myRng.Value
 
  For j = 1 To 6
  For i = 1 To 5
 '  Debug.Print myArray(j, i)
  Set myTxt = Controls("TextBox" & j & i)
    myTxt.Text = myArray(j, i)
  Next i
  Next j
End If
End Sub


【19307】Re:ここまでは考えたのですが・・・.
発言  Hirofumi  - 04/10/27(水) 21:19 -

引用なし
パスワード
   > 1 各月の1日のセルを探す。
> 2 1日の曜日を判定して、金曜日までの時間割を配列に格納。
> 3 テキストボックスに書き出す。
> 4 月曜日を取得して、第?月曜日 ←ここがわからない。
> 5 その日から金曜日までのセルの値を配列に格納
> 6 テキストボックスに書き出す。第?+週。

基本的に、私のコードは、上記の様に作成しています
ただ、TextBoxに書き出すのに配列を使う意味が余り無いので
使っていません(セルに書き出すなら意味が有るような気がしますが?)

「1、」については、基準のセル位置の列に必ず有るはずで、
各月が一定の行ピッチで書かれているば、

基準セル位置 + 其の月の順番 * 行ピッチ

で出ますよね?

「4、」については、Functionを作り、
「第?週の月曜日」は何日と言う形で取得しています

【19308】Re:ここまでは考えたのですが・・・.
発言  ponpon  - 04/10/27(水) 21:38 -

引用なし
パスワード
   ▼Hirofumi さん:
>> 1 各月の1日のセルを探す。
>> 2 1日の曜日を判定して、金曜日までの時間割を配列に格納。
>> 3 テキストボックスに書き出す。
>> 4 月曜日を取得して、第?月曜日 ←ここがわからない。
>> 5 その日から金曜日までのセルの値を配列に格納
>> 6 テキストボックスに書き出す。第?+週。
>
>基本的に、私のコードは、上記の様に作成しています
>ただ、TextBoxに書き出すのに配列を使う意味が余り無いので
>使っていません(セルに書き出すなら意味が有るような気がしますが?)

 その辺もよくわからないものですから・・
 ただ、配列を使うと速いのかな何て思いまして、それと一度に一週間分の値が取得できるというのもいいなと思いまして・・・・

>「1、」については、基準のセル位置の列に必ず有るはずで、
>各月が一定の行ピッチで書かれているば、
>
>基準セル位置 + 其の月の順番 * 行ピッチ
>
>で出ますよね?

はい、いわれれば確かに出ます。

>「4、」については、Functionを作り、
>「第?週の月曜日」は何日と言う形で取得しています

これは、提示していただいたコードをもう少し分析させてください。
確か目安箱にjakaさんが書いていたような気がしますが、そちらも参考に
させてもらおうかなと思っています。
 また、わからなかったら質問します。
 よろしくお願いします。

【19309】Re:ここまでは考えたのですが・・・.
回答  Hirofumi  - 04/10/27(水) 22:05 -

引用なし
パスワード
   一応、コメントを付けて見ましたけれど
何か言い回しが下手で上手く説明が出来ていないかも?

前回のコードを少し整理、変更してあります
カレンダの有るシートを見ているのは、
基準位置の日付(シリアル値)だけです
日付の位置は、基準セル位置と、月が書かれている行のピッチから
計算して出しています
詰まり、シートには、基準セル位置に、シリアル値が有れば後は何も無くても動きます

UserFormのコントロール
ComboBox1 :月表示用
ComboBox2 :週表示用
Label2〜6 :日付表示用
TextBox21〜26 :月曜1〜6時限表示
TextBox31〜36 :火曜1〜6時限表示
TextBox41〜46 :水曜1〜6時限表示
TextBox51〜56 :木曜1〜6時限表示
TextBox61〜66 :金曜1〜6時限表示
CommandButton1  :時間割表示
CommandButton2  :更新
CommandButton1  :閉じる
で作って有ります

尚、Userformの呼び出し時に、月の書かれている行ピッチを指定できる様に変更して有ります


Public Sub UserFormShow()

  With UserForm1
    '行ピッチの指定(此れを指定しない場合、9行ピッチ)
    .lngMonthPitch = 11
    .Show
  End With
  
End Sub


Option Explicit

'全てのモジュールら参照出来る変数を宣言
'月が書かれている行のピッチ
'例、4月が1行目で、5月が10行目なら9行ピッチ
Public lngMonthPitch As Long

'UserForm内全てから参照出来る変数を宣言
'データ出力の基準セル位置(4月1日のセル位置)
Private rngListTop As Range
'週の先頭の日付
Private dtmCurrent As Date

Private Sub ComboBox1_Change()
'月が変更された場合

  Dim i As Long
  Dim lngWeek As Long
  
  'ComboBox1で選択された月が何週有るかを計算
  lngWeek = GetWeekNumb(DateValue(ComboBox1.Value & "1日"))
  'ComboBox2に計算された週をセット
  With ComboBox2
    .Clear
    For i = 1 To lngWeek
      .AddItem i & "週"
    Next i
    .ListIndex = 0
  End With
  '選択されている月、週からシートのデータを
  'TextBoxに読み込む
  WeekChange
  
End Sub

Private Sub ComboBox2_Change()
'週が変更された場合

  '選択されている月、週からシートのデータを
  'TextBoxに読み込む
  WeekChange
  
End Sub

Private Sub CommandButton2_Click()
'更新ボタンが押された場合

  'TextBoxのデータをシートに出力
  DataPut
  
End Sub

Private Sub CommandButton3_Click()

  Unload Me
  
End Sub

Private Sub UserForm_Initialize()

  Dim i As Long
  Dim lngYear As Long
  
  'デフォルトとして9行ピッチを設定
  lngMonthPitch = 9
  
  'カレンダーの4月1日のセル位置を設定(基準セル)
  Set rngListTop = ActiveSheet.Cells(1, "B")
  With rngListTop
    '基準セルのシリアル値から年を取得
    '年が無いと曜日が取得できない
    If IsDate(.Value) Then
      lngYear = Year(.Value)
    Else
      lngYear = Year(Date)
    End If
  End With
        
  'ComboBox1の設定
  With ComboBox1
    'ドロップダウンリストとする
    .Style = fmStyleDropDownList
    '月を設定(年を付加、4月から翌年3月まで)
    'lngYear + (i + 3) \ 12は、iが9を超えると1が加算される
    '詰まり、1月以降は翌年に成る
    '((i + 3) Mod 12) + 1は、iが0〜11に変かするに伴い
    '4〜3の値が計算される
    For i = 0 To 11
      .AddItem (lngYear + (i + 3) \ 12) & "年" _
              & (((i + 3) Mod 12) + 1) & "月"
    Next i
  End With
  'ComboBox2の設定
  With ComboBox2
    'ドロップダウンリストとする
    .Style = fmStyleDropDownList
  End With
  
End Sub

Private Sub UserForm_Terminate()

  '基準位置の参照を破棄
  Set rngListTop = Nothing
  
End Sub

Private Function GetWeekNumb(dtmMonth As Date) As Long
'月が何週有るか計算する関数

  Dim i As Long
  Dim dtmTop As Date
  Dim dtmEnd As Date
  
  '月初の有る週の日曜の日付を計算
  dtmTop = dtmMonth - (WeekDay(dtmMonth) - 1)
  '翌月の月初の日付を計算
  dtmEnd = DateAdd("m", 1, dtmMonth)
  
  '戻り値をして、先頭週の日曜から月末までの日数を
  '7日で割って切り上げる(一月が何週に成るか計算)
  GetWeekNumb = -Int(-(dtmEnd - dtmTop) / 7)
  
End Function

Private Function GetWeekDay(dtmMonth As Date, _
              lngWeek As Long) As Date
'指定月(月の1日を指定)の指定週の先頭の日付を返す関数

  Dim i As Long
  Dim dtmTop As Date
  Dim dtmEnd As Date
  
  '第1週の場合
  If lngWeek = 1 Then
    '月初の日付を返す
    GetWeekDay = dtmMonth
  Else
    '月初の有る週の日曜の日付を計算
    dtmTop = dtmMonth - (WeekDay(dtmMonth) - 1)
    '先頭日付に指定週分の日数+1を加算して週の先頭日付を返す
    GetWeekDay = DateAdd("ww", lngWeek - 1, dtmTop) + 1
  End If
  
  
End Function

Private Sub DataRead()
'シートのデータをTextBoxに読み込む

  Dim i As Long
  Dim j As Long
  Dim lngRow As Long
  Dim lngCol As Long
  Dim dtmTop As Date
  
  '週の先頭日付からシートの行列位置を
  '基準セルからのOffset値として計算
  LocateCalc dtmTop, lngRow, lngCol
  '視認性の為セルをSelect(無くてもOk)
  rngListTop.Offset(lngRow - 2, lngCol).Select
  
  'TextBoxに読み込み
  For i = 2 To 6
    'もし、実際の週先頭の日(日曜日)から(i-1)日目の月が、
    '週先頭の月と同じなら(月初の様に週先頭と第一週の先頭日が違う時の処理)
    'dtmTopは、常に日曜日を指し、10月の第1週は9/26日
    'dtmCurrentは、例えば、月初の場合10/1が金曜で有っても週先頭としている
    If Month(dtmTop + i - 1) = Month(dtmCurrent) Then
      'ラベルに日付を書き込む
      Controls("Label" & i).Caption = Format(dtmTop + i - 1, "m/d(aaa)")
      '1〜6時限のセルを読み出す
      For j = 1 To 6
        Controls("TextBox" & i & j).Text _
            = rngListTop.Offset(lngRow + j - 1, lngCol).Value
      Next j
      lngCol = lngCol + 1
    '月が違う場合
    Else
      'ラベルをクリア
      Controls("Label" & i).Caption = ""
      'TextBoxをクリア
      For j = 1 To 6
        Controls("TextBox" & i & j).Text = ""
      Next j
    End If
  Next i
  
End Sub

Public Sub DataPut()
'TextBoxの値をセルに書き出し

  Dim i As Long
  Dim j As Long
  Dim lngRow As Long
  Dim lngCol As Long
  Dim dtmTop As Date
  
  LocateCalc dtmTop, lngRow, lngCol
  rngListTop.Offset(lngRow - 2, lngCol).Select
  For i = 2 To 6
    If Month(dtmTop + i - 1) = Month(dtmCurrent) Then
      For j = 1 To 6
        rngListTop.Offset(lngRow + j - 1, lngCol).Value _
                  = Controls("TextBox" & i & j).Text
      Next j
      lngCol = lngCol + 1
    End If
  Next i
  
End Sub

Private Sub LocateCalc(dtmTop As Date, _
            lngRow As Long, _
            lngCol As Long)
'セル位置(Offset値)の計算

  'dtmCurrentの日付が含まれる週の先頭日付
  dtmTop = dtmCurrent - (WeekDay(dtmCurrent) - 1)
  'シートの列位置
  lngCol = Day(dtmCurrent) - 1
  'シートの行位置
  '(Month(dtmCurrent) + 8) Mod 12は、月の順番(順位?)を計算
  '4月は0番目、3月は11番目
  'lngMonthPitchは、月が書かれている行のピッチ
  '例、4月が1行目で、5月が10行目なら9行ピッチ
  lngRow = ((Month(dtmCurrent) + 8) Mod 12) _
                * lngMonthPitch + 2

End Sub

Private Sub WeekChange()
'各ComboBoxが変化した特の処理
  If ComboBox1.ListIndex <> -1 _
      And ComboBox2.ListIndex <> -1 Then
    dtmCurrent = GetWeekDay(CDate(ComboBox1.Value & "1日"), _
                      Val(ComboBox2.Value))
    DataRead
  End If
  
End Sub

【19310】Re:ここまでは考えたのですが・・・.
お礼  ponpon  - 04/10/27(水) 23:25 -

引用なし
パスワード
   ▼Hirofumi さん:
>一応、コメントを付けて見ましたけれど
>何か言い回しが下手で上手く説明が出来ていないかも?

 いえいえ、大変な作業をありがとうございました。細かいところは別として、非力な私にも「なるほど」と思うところがたくさんありました。
 ありがとうございました。
 はじめに、VBAを使わずに、関数でできるだけがんばって組んでいたので、VBAでする場合に、いろいろと不都合が出てきました。ループさせるのにいろいろと苦労しています。
 学期ごとに組んでいるので、4 5 6 7月と8 9 10 11 12月の間に入力用時間割表があったり、VBAを始めてああしておけばよかったと思うことがたくさんあります。
 提示していただいたコードやコメントにたくさん参考になったり、考えさせられた考え方がたくさんありました。
 もう少しで自力解決できそうです。使えるコードは使わせていただきます。
 大変ありがとうございました。今後ともよろしくお願いします。


>前回のコードを少し整理、変更してあります
>カレンダの有るシートを見ているのは、
>基準位置の日付(シリアル値)だけです
>日付の位置は、基準セル位置と、月が書かれている行のピッチから
>計算して出しています
>詰まり、シートには、基準セル位置に、シリアル値が有れば後は何も無くても動きます
>尚、Userformの呼び出し時に、月の書かれている行ピッチを指定できる様に変更して有ります。

  大変助かります。カレンダーの方は、自分でピッチを変えたり、背景色を変えたり、土日の時間割の部分を””にできたのですが、それだとユーザーホームで呼び出したとき、4月はよいのですが5月以降がずれて表示され、困っていたところです。

>  '月初の有る週の日曜の日付を計算
>  dtmTop = dtmMonth - (WeekDay(dtmMonth) - 1)

 これはカンレンダー形式のもう一つの年間時間割の時に使ってました。第一月曜日が何日になるかということで、でも本を見て作ったのものですから忘れてました。


>    '先頭日付に指定週分の日数+1を加算して週の先頭日付を返す
>    GetWeekDay = DateAdd("ww", lngWeek - 1, dtmTop) + 1
                ↑    
               "WW" これは、何でしょう?DateAddのヘルプを見ると、「追加する時間間隔を表す文字列式を指定します」となっていたのですが、意味がわかりません。確か本で「ちらっ」と見たような覚えがあるのですが・・・

【19348】Re:ここまでは考えたのですが・・・.
回答  Hirofumi  - 04/10/28(木) 20:15 -

引用なし
パスワード
   >>    '先頭日付に指定週分の日数+1を加算して週の先頭日付を返す
>>    GetWeekDay = DateAdd("ww", lngWeek - 1, dtmTop) + 1
>                ↑    
>               "WW" これは、何でしょう?DateAddのヘルプを見ると、「追加する時間間隔を表す文字列式を指定します」となっていたのですが、意味がわかりません。確か本で「ちらっ」と見たような覚えがあるのですが・・・

本音を言うと私も、滅多にDateDiff、DateAddは使いません
今回は気が向いたので使っています
此れは、以下の様に書きなおしても、結果は同じだと思います

    '先頭日付に指定週分の日数+1を加算して週の先頭日付を返す
    GetWeekDay = (dtmTop + 7 * (lngWeek - 1)) + 1

日付(シリアル値)は、本来、日付部分だけならLong値、時刻を含めてDouble値なので
通常の計算で大抵済ましてしまいます

因みに、前のコードでは、WeekDay関数を使っていませんが

  (日付の変数 - 1) Mod 7 + 1

でも、WeekDay関数と同じ結果が得られます

【19349】Re:ここまでは考えたのですが・・・.
お礼  ponpon  - 04/10/28(木) 21:15 -

引用なし
パスワード
   ▼Hirofumi さん:

>各月が一定の行ピッチで書かれているば、
>基準セル位置 + 其の月の順番 * 行ピッチ
>で出ますよね?
 で、あったり、下のような数式など、
 関数を使わなくてもちゃんと計算することができるのですね。
 文系なものですから、数字から法則や規則を見つけるのが苦手で・・・申し訳ありませんでした。詳しい説明をありがとうございました。

>
>本音を言うと私も、滅多にDateDiff、DateAddは使いません
>今回は気が向いたので使っています
>此れは、以下の様に書きなおしても、結果は同じだと思います
>
>    '先頭日付に指定週分の日数+1を加算して週の先頭日付を返す
>    GetWeekDay = (dtmTop + 7 * (lngWeek - 1)) + 1


>日付(シリアル値)は、本来、日付部分だけならLong値、時刻を含めてDouble値なので
>通常の計算で大抵済ましてしまいます
>
>因みに、前のコードでは、WeekDay関数を使っていませんが
>
>  (日付の変数 - 1) Mod 7 + 1
>
>でも、WeekDay関数と同じ結果が得られます

10891 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free