[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAで時間の増減』（たまひよこ）
投稿内容が見づらい為、再投稿させていただきました。
宜しくお願い致します。
VBAでB14〜Q19の指定した範囲にある時間の入力セルすべてに対して増減をしたいです
↓作りたいユーザーフォーム↓
コンボボックス
1時間
2時間
・
・
8時間
チェックボックス
☑30分
オプションボタン
⦿増やす
⦿減らす
OKボタンとキャンセルボタン
|[B]|[C]|[D]|[E] |[F]|[G] |[H]|[I] |[J]|[K] |[L]|[M] |[N]|[O] |[P]|[Q]
[14]|a | | |20:30| |0:30|b | | |1:00| |4:00 |c | | |8:00
[15]|入 | | | | | |休 | | | | | |休 | | |
[16]| | | | | | | |9:00|d | | |10:00| |11:30|z |
[17]| | |待 | | | | | |待 | | | | | |出 |
[18]| | | | | | | | | | | | | | | |
[19]| | | | | | | | | | | | | | | |
↓作ったユーザーフォームよりコンボボックスで1時間を選択し、
チェックボックス30分を選択、オプションボタンで増やすを選択した場合↓
|[B]|[C]|[D]|[E] |[F]|[G] |[H]|[I] |[J]|[K] |[L]|[M] |[N]|[O] |[P]|[Q]
[14]|a | | |22:00| |2:00|b | | |2:30| |5:30 |c | | |9:30
[15]|入 | | | | | |休 | | | | | |休 | | |
[16]| | | | | | | |10:30|d | | |11:30| |13:00|z |
[17]| | |待 | | | | | |待 | | | | | |出 |
[18]| | | | | | | | | | | | | | | |
[19]| | | | | | | | | | | | | | | |
となるようにしたいです。
どのようなコードで書けば思うようなものになるのか教えてください。
宜しくお願いします。
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
こんにちは ＾＾ あのぉ〜ユーザーフォームじゃないといけないですか。 空きセル3,4個で代替できそぉなきがしないでもないのですが。 で どのあたりで、おこまりで。。。 m(_ _)m
（隠居じーさん） 2021/02/10(水) 13:45
(1)何かが入力されていて時刻（日付型）に見えるデータ（セル）をピックアップする (2)↑でピックアップしたセルを巡回して、それぞれ計算する
でいいような気がします。
実際どのへんで詰まっているのですか？
(1)で詰まってるというなら別ですけど、(2)で詰まってるということであれば、例えばA1セルに限定したらどうなるかということを考えて書いてみてはどうでしょうか？
例のとおりなら、「A1セルの値」に「1時間」と「30分」足せばいいんですよね？
（もこな２ ） 2021/02/10(水) 14:00
ユーザーフォームの部分だけ準備してみました (だけなので実際には何もしてくれません)
Option Explicit
Private CmbHour As MSForms.ComboBox
Private ChkHalf As MSForms.CheckBox
Private OptInc As MSForms.OptionButton
Private OptDec As MSForms.OptionButton
Private WithEvents BtnOK As MSForms.CommandButton
Private WithEvents BtnCancel As MSForms.CommandButton
Private Sub UserForm_Initialize()
Dim i As Long
Set CmbHour = Me.Controls.Add("Forms.ComboBox.1", "CmbHour")
With CmbHour
For i = 1 To 8
.AddItem i & "時間"
Next
.Style = fmStyleDropDownList
End With
Set ChkHalf = Me.Controls.Add("Forms.CheckBox.1", "ChkHalf")
With ChkHalf
.Left = 96
.Caption = "30分"
End With
Set OptInc = Me.Controls.Add("Forms.OptionButton.1", "OptInc")
With OptInc
.Top = 24
.Caption = "増やす"
.Value = True
End With
Set OptDec = Me.Controls.Add("Forms.OptionButton.1", "OptDec")
With OptDec
.Top = 24: .Left = 96
.Caption = "減らす"
End With
Set BtnOK = Me.Controls.Add("Forms.CommandButton.1", "BtnOK")
With BtnOK
.Top = 48
.Caption = "OK"
End With
Set BtnCancel = Me.Controls.Add("Forms.CommandButton.1", "BtnCancel")
With BtnCancel
.Top = 48: .Left = 96
.Caption = "キャンセル"
End With
End Sub
Private Sub BtnOK_Click()
Dim at As String
at = Replace$(CmbHour.Value, "時間", "")
If at = "" Then at = "0"
at = at & IIf(ChkHalf.Value, ":30", ":00")
MsgBox at & IIf(OptInc.Value, OptInc.Caption, OptDec.Caption)
End Sub
思ったんですけど、オプションボタンで増減選択するより [増やす]ボタンと[減らす]ボタンにした方が使い易くないでしょかね?
（白茶） 2021/02/10(水) 14:52
もこな２様
(1)で詰まってるです。
もこな２様が例でおっしゃるとおりですが、
範囲は固定ですが私は例で1時間30分で記載しましたが
単純に1時間30分だけの増減だけではなく時間数と増減は使用するタイミングで都度違います。
白茶様
ありがとうございます。
思ったんですけど、オプションボタンで増減選択するより [増やす]ボタンと[減らす]ボタンにした方が使い易くないでしょかね?
確かにおっしゃる通りです。
考えが至らなかったです・・
（たまひよこ） 2021/02/10(水) 15:45
■例えばA1セルに限定した場合として考えると 【A1セルの値】に （【コンボボックスで選んだ時間】+【チェックボックスでの選択結果（0分or30分）】）を 【オプションボタンの選択したほう（加算or減算】する
ってことでしょ？と言いたかったわけですが・・・
こちらが分かれば
(1) セルを巡回して、日付型に見えるセルをピックアップする (2)ピックアップしたセルを巡回して計算して書き込む
という処理が組み立てられるとおもって、どこで詰まっているのか確認したのです。
（もこな２ ） 2021/02/10(水) 16:20
上手くお伝え出来ず、すみません。
そうです、おっしゃる通りです。
(1) セルを巡回して、日付型に見えるセルをピックアップする (2)ピックアップしたセルを巡回して計算して書き込む
まさにしたい事、そのものです。
（たまひよこ） 2021/02/10(水) 16:57
(1)ユーザーフォームで入力（選択）した内容から何時間何分を加算（減算）すればよいか取得する (2)決まったセル範囲を巡回して、値が時刻としてみなせるものが入っているセルがあれば(1)の計算をして書き換える
巡回のほうで詰まっているなら、とりあえず（１）のほうを考えてみてはどうですか？
（もこな２ ） 2021/02/10(水) 17:40
Sub さんぷる01()
Dim MyRNG As Range
For Each MyRNG In ActiveSheet.Range("B14:Q19")
If MyRNG.NumberFormatLocal = "h:mm" Then
MsgBox MyRNG.Address(False, False) & " は処理が必要です"
End If
Next
End Sub
ちなみに、0：30の時に、１時間引いたらマイナスになりますけど、そういう場合どうするんですか？
（もこな２ ） 2021/02/10(水) 18:18
VBAは本当に素人で、質問する際のフォームの名称もネットで調べた位の知識なもので。。
何が違うのかわからなくて…すみません。
ちなみに、0：30の時に、１時間引いたらマイナスになりますけど、そういう場合どうするんですか？
23：30分となるようにしたいです。
（たまひよこ） 2021/02/10(水) 18:44
(1)処理すべきセルをピックアップしておいてから (2)(1)のセル【すべて】に処理をしていく方法
こちらのほうが〜としたのは
(1)加算（減算）すべき時間を固めておいてから (2)すべてのセルを順番に見ていき【処理すべきセルであれば】(1)の計算を行うとしたもの
＞VBAは本当に素人で〜
そういう状態であれば、なおさら加算（減算）すべき時間を固めるところから手を付けたほうがよいとおもいます。
一番とっかかりやすいと思うので・・・
白茶さんがアドバイスしてくださってるのをよく研究してみてください。
繰り返しになりますが、
【コンボボックス】で選んだ"文字列"から"時間"という文字を除いたもの → 時間に相当 【チェックボックス】の選択状態 → 30分 or 00分 【オプションボタン】の選択状態 → 加算 or 減算 （というか-1を掛けるか否か）
これらを組み合わせれば、どのような計算をすべきかまでは出せますよね？
（もこな２ ） 2021/02/10(水) 20:23
申し訳ありませんが難しいです。。
ここに書き込みする前に自分のしたい事を検索したのですが、
見本が見つからずその書き方が分からないのです。
実務で使用したくあまり時間が取れないので、サンプルを教えていただくことはできませんか？
フォーム部分は白茶様がサンプルを書いてくださったのを見て、
それを改めて調べてなるほど！と現況理解している感じです。。。
（たまひよこ） 2021/02/10(水) 21:45
それなりにヒントは出したとおもいますし、気が変わって自分でやってみようと思ったら、思う通りの動きでなくとも、まずはそれを提示してみてください。
（もこな２） 2021/02/10(水) 22:42
サンプルひとつ作ってみましたよ。 かなり「いいかげん」な作りですから、そのまま実務に使えるとは思わないでくださいね。 あくまで教材代わりだと思って下さい。
>改めて調べてなるほど！と現況理解 いいですねぇ! それ一番大切な事だと思いますよ。
Option Explicit
Private CmbHour As MSForms.ComboBox
Private ChkHalf As MSForms.CheckBox
Private WithEvents BtnInc As MSForms.CommandButton
Private WithEvents BtnDec As MSForms.CommandButton
Private Sub UserForm_Initialize()
Dim i As Long
Set CmbHour = Me.Controls.Add("Forms.ComboBox.1", "CmbHour")
With CmbHour
For i = 0 To 8
.AddItem i & "時間"
Next
.Style = fmStyleDropDownList
.ListIndex = 0
End With
Set ChkHalf = Me.Controls.Add("Forms.CheckBox.1", "ChkHalf")
With ChkHalf
.Left = 96
.Caption = "30分"
End With
Set BtnInc = Me.Controls.Add("Forms.CommandButton.1", "BtnInc")
With BtnInc
.Top = 24
.Caption = "増やす"
End With
Set BtnDec = Me.Controls.Add("Forms.CommandButton.1", "BtnDec")
With BtnDec
.Top = 24: .Left = 96
.Caption = "減らす"
End With
End Sub
Private Sub BtnDec_Click()
TimeAdd -1
End Sub
Private Sub BtnInc_Click()
TimeAdd 1
End Sub
Private Sub TimeAdd(Sign As Long)
Dim r As Range, v As Double, t As String
t = Replace$(CmbHour.Value, "時間", "")
t = t & IIf(ChkHalf.Value, ":30", ":00")
For Each r In Range("B14:Q19").Cells
If WorksheetFunction.IsNumber(r.Value) And Not r.HasFormula Then
v = TimeValue(r.Text) + TimeValue(t) * Sign
If v < 0 Then v = v + 1
r.Value = WorksheetFunction.Text(v, "h:mm")
End If
Next
End Sub
（白茶） 2021/02/10(水) 23:14
Sub 研究用()
Dim コンボボックス As String
Dim チェックボックス As Boolean
Dim オプションボタン増 As Boolean
Dim オプションボタン減 As Boolean
Dim 増減 As Long
Dim 増減時間 As Date
Dim MyRNG As Range
コンボボックス = "1時間"
チェックボックス = True
オプションボタン増 = True
オプションボタン減 = False
Stop 'ブレークポイントの代わり
増減時間 = Replace(コンボボックス, "時間", "") & IIf(チェックボックス, ":30", ":00")
増減 = IIf(オプションボタン増, 1, -1)
For Each MyRNG In ActiveSheet.Range("B14:Q19")
If MyRNG.NumberFormatLocal = "h:mm" Then
MyRNG.Value = Format(CDate("1900/1/2 " & MyRNG.Text) + (増減時間 * 増減), "h:mm")
End If
Next
End Sub
（もこな２） 2021/02/11(木) 22:10
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.