Results of 1 - 1 of about 13158 for 日付 (0.003 sec.)
- [[20211213141600]]
- #score: 2423
- @digest: df8a43ea1b69e4b61914f8d754b68208
- @id: 89894
- @mdate: 2022-01-05T14:06:23Z
- @size: 31904
- @type: text/plain
- #keywords: 限切 (89454), overdue (88570), condition (85076), targetday (80655), ロニ (40197), 期限 (35326), マカ (24899), controls (22337), カロ (21998), start (20881), textbox (17493), label (16630), 付列 (15964), 行取 (15549), 破棄 (15083), maxrow (14391), 示行 (12988), 切れ (10576), 名称 (8902), vbcrlf (8375), caption (8109), unload (7646), col (6759), 行, (6690), initialize (6627), cnt (5618), 日付 (4909), sample (4834), lastrow (4603), 更新 (4420), tmp (4088), 列) (4044)
- 『期限切れの名称表示および日付の更新』（マカロニ）
こんにちは。 どうにもこうにも上手く動作ができず作業が進まなくて困っているため、 教えていただけたら幸いです。 【台帳の記載内容】 range("B3")に今日の日付(=TODAY())を表示 ・A列に名称、H列に更新前の日付、I列に最新の日付 【ユーザーフォームの設定】 ・Label1〜Label10、TextBox1〜TextBox10を設置し、 Range("B3")の日付よりも超過した日付(H列)の名称(A列)を Lavelに表示させ、更新後の日付をTextBoxに直接入力 ・ユーザーフォーム内に設置された更新ボタン(CommandButton1)を押すと、 Labelに表示された名称と一致した行のセル(I列)にTextBoxに入力した日付を自動入力 ・超過がゼロの場合はmsgbox"期限切れはありません"と表示 Dim xlLastRow As Long Dim Max_Score As Long Dim Last_Row As Variant Dim i As Long Max_Score = Range("B3") '今日の日付 xlLastRow = Cells(Rows.Count, 1).Row 'Excelの最終行を取得 Lastrow1 = Cells(xlLastRow, 8).End(xlUp).Row 'H列最終行 For i = 16 To Lastrow1 '15行目が見出しで16行目から一覧が表示 If Cells(i, 8) >= Max_Score Then 'もしHの列の日付がtodayを過ぎてたら ・ ・ ・ ・ ・ msgbox"期限切れはありません" unload me 該当名称全てをLabelに表示させていき、TextBoxに入力した日付を台帳へ更新するコードを教えて頂けたらと思います。 以上、宜しくお願いします。 ＜ 使用 Excel:Office365、使用 OS:unknown ＞ ---- Label,TextBoxが10づつですが、 更新するものが10以上だったら どうするんですか? 私なら、Label1,TextBox1のみにして、 期限切れが無くなるか、キャンセル処理が入るまで、 ループさせる、と思います。 （tkit） 2021/12/13(月) 15:32 ---- コメントありがとうございます。 毎月チェックしなければならない台帳により、 10以上入ることはないと過去の経験から設置に上限を10としています。 また、10以上になった際は、 msgboxで"10以上あるため、表示不可能"を検討しています。 （マカロニ） 2021/12/13(月) 15:53 ---- ＞過去の経験から設置に上限を10としています。 分かりました。 案だけですが、 配列または連想配列に期限切れの名前、行を代入しておきますね。 まぁご自身で考えてみてください。 （tkit） 2021/12/13(月) 17:14 ---- ありがとうございます。 提案を基に作成してみます。 （マカロニ） 2021/12/14(火) 11:07 ---- ユーザーフォームを、呼び出し時に Initializeで名称を表示させるって事ですよね? 因みに、名称についてですが重複はありませんか? （あみな） 2021/12/14(火) 12:17 ---- コメントありがとうございます。 ＞ ユーザーフォームを、呼び出し時に Initializeで名称を表示させるって事ですよね? ＞＞はい。 Initializeで項目を表示させてます。 ＞因みに、名称についてですが重複はありませんか? ＞＞重複はありません。 （マカロニ） 2021/12/14(火) 12:57 ---- >項目を表示させています。 超過日付を基に、名称は表示てきてるのですね? そこまで出来るなら後も出来そうな気がするんだが(-∀-) （あみな） 2021/12/14(火) 13:48 ---- Dim LastRow As Long Dim TargetDay As Long Dim 期限 As String Dim i As Long '最終行取得 LastRow = Cells(Rows.Count, 1).End(xlUp).Row '日付 TargetDay = Range("B3") '行ループ For i = 16 To LastRow '指定の期限が切れている場合、変数にデータを格納 If Cells(i, 8) < TargetDay Then 期限 = 期限 & Cells(i, 1) End If Next i If 期限 = "" Then MsgBox "期限切れはありません。" Unload Me Else 【条件コード】 end if end sub 1,期限切れの名称を”期限”に格納し、ラベルに表示する。 2,テキストボックスに日付を入力し、”期限”と一致した行の台帳H列へ抽出 3,unload me 一日考えましたが、どうにもうまく動作しません。 教えて頂けないでしょうか。 （マカロニ） 2021/12/15(水) 10:16 ---- 当該の行も記録しないと、変更後の反映ができませんよ。 （きまぐれおじさん） 2021/12/15(水) 10:43 ---- とりあえず、Initializeでラベルとテキストに期限切れを表示するコード例 該当する行番号をテキストボックスのTagプロパティに格納するようにしました。 ---- Private Sub UserForm_Initialize() Dim LastRow As Long Dim TargetDay As Long Dim cnt As Long Dim i As Long '最終行取得 LastRow = Cells(Rows.Count, 1).End(xlUp).Row '日付 TargetDay = Range("B3") '行ループ For i = 16 To LastRow '指定の期限が切れている場合、変数にデータを格納 If Cells(i, 8) < TargetDay Then cnt = cnt + 1 Me.Controls("Label" & cnt).Caption = Cells(i, 1) Me.Controls("TextBox" & cnt).Value = Cells(i, 8) Me.Controls("TextBox" & cnt).Tag = i End If Next i If cnt = 0 Then MsgBox "期限切れはありません。" Unload Me End If End Sub （hatena） 2021/12/15(水) 10:59 ---- Dim rList() As Long Dim LastRow As Long Dim TargetDay As Long Dim ListCount Dim i As Long '最終行取得 LastRow = Cells(Rows.count, 1).End(xlUp).row '日付 TargetDay = Range("B3").Value2 '※シリアル値を代入するならValue2 '行ループ For i = 16 To LastRow '指定の期限が切れている場合、変数にデータを格納 If Cells(i, 8).Value2 < TargetDay Then ReDim Preserve rList(ListCount) rList(ListCount) = i '行の情報からあとでH列とA列の値は取得できるので行の値だけ配列に入れる ListCount = ListCount + 1 End If Next i If ListCount < 1 Then MsgBox "期限切れはありません。" Unload Me Else 【条件コード】 End If 気づいた点を直すとこんな感じでしょうか （きまぐれおじさん） 2021/12/15(水) 11:03 ※11:14修正 ---- コマンドボタンでテキストボックスの更新をシートに反映させるコードも追加しました。 --- Option Explicit Dim cnt As Long Private Sub CommandButton1_Click() Dim i As Long For i = 1 To cnt With Me.Controls("TextBox" & i) Cells(.Tag, 8) = .Value End With Next Unload Me End Sub Private Sub UserForm_Initialize() Dim LastRow As Long Dim TargetDay As Long Dim i As Long '最終行取得 LastRow = Cells(Rows.Count, 1).End(xlUp).Row '日付 TargetDay = Range("B3") '行ループ For i = 16 To LastRow '指定の期限が切れている場合、変数にデータを格納 If Cells(i, 8) < TargetDay Then cnt = cnt + 1 Me.Controls("Label" & cnt).Caption = Cells(i, 1) Me.Controls("TextBox" & cnt).Value = Cells(i, 8) Me.Controls("TextBox" & cnt).Tag = i End If Next i If cnt = 0 Then MsgBox "期限切れはありません。" Unload Me End If End Sub （hatena） 2021/12/15(水) 11:13 ---- お二方教えて頂きありがとうございます。 コードを記述しても動作がうまくいかないため、 一晩考えてわからなかかったら再度こちらに書き込みさせて頂きます。 （マカロニ） 2021/12/15(水) 16:47 ---- ＞・ユーザーフォーム内に設置された更新ボタン(CommandButton1)を押すと、 ＞Labelに表示された名称と一致した行のセル(I列)にTextBoxに入力した日付を自動入力 ↑最初と ↓後日では更新後の日付を入力する列が違うけども...調整はご自由に ＞2,テキストボックスに日付を入力し、”期限”と一致した行の台帳H列へ抽出 Match でやってみました。どうでしょうか?...調整はご自由にどぞ Option Explicit Private Sub UserForm_Initialize() Dim today As Date Dim i, cnt As Long Dim MaxRow As Long Dim ws As Worksheet Dim x As String, tmp As String Dim Overdue(1 To 10) As String '' 期限切れ Overdue or Expired Set ws = Sheets(1) Const START_COL = 8& today = Date MaxRow = ws.Cells(Rows.Count, START_COL).End(xlUp).Row On Error GoTo Err '' 期限切れが、10件以上の対策 For i = 16 To MaxRow If IsDate(Cells(i, START_COL).Value) Then x = Cells(i, START_COL).Value If x <= Range("B3").Value Then '' Range("B3").Value をtodayで代替可 cnt = cnt + 1 Overdue(cnt) = Cells(i, START_COL).Address _ (RowAbsolute:=False, ColumnAbsolute:=False) Me.Controls("Label" & cnt).Caption = Cells(i, START_COL).Offset(, -7) End If End If Next If cnt <> 0 Then For i = 1 To cnt tmp = tmp & Overdue(i) & vbCrLf Next MsgBox "期限切れがあります" & vbCrLf _ & tmp, vbInformation Else: MsgBox "期限切れはありません" End If Exit Sub Err: MsgBox "期限切れが、10件以上あります" Err.Clear End Sub Private Sub CommandButton1_Click() Dim i As Long Dim MaxRow As Long Dim ws As Worksheet Dim x As String, tmp As String Const START_COL = 8& Set ws = Sheets(1) MaxRow = ws.Cells(Rows.Count, START_COL).End(xlUp).Row For i = 1 To 10 '' Label1〜Label10、TextBox1〜TextBox10の設置数分のみTextBoxから更新後の日付を入力 x = Me.Controls("Label" & i).Caption tmp = WorksheetFunction.Match(x, Range("A16:A" & MaxRow), 0) ws.Range("I" & tmp + 15).Value = Format(Me.Controls("TextBox" & i), "yyyy/m/d") Next Unload Me End Sub （あみな） 2021/12/15(水) 17:00 ---- あみな様、コードのご教授ありがとうございます。 TODAYより過ぎた日付を探す列 … I 更新後の日付を入力する列 …H ＜今回追加のご質問＞ 破棄または保管など特定の文字が入力される列 … L 上記のコードに追加で、特定の文字がL列に文字が入力されたら、 期限が過ぎていてもLabelに表示させない。としたいです。 ご質問ばかりで申し訳ありません。 教えて頂いたコードが難しく、読み解くことができず再びご質問させてください。 よろしくお願いします。 （マカロニ） 2021/12/23(木) 09:48 ---- 今更ですが、Inputbox案を提示します。 標準モジュールに貼り付けて、実行してみてください。 UserFormに拘らず、試してみてください。 コードは割とスッキリしてると思いますし、 日本語で分かりやすくしたつもりです。 コンパイルチェックのみしか確認していませんので、あしからず。 Option Explicit 'モジュールレベル定数 Private Const 名称列 As Long = 1 'A列 Private Const 日付列 As Long = 9 'I列 Private Const 更新列 As Long = 8 'H列 Private Const チェック列 As Long = 12 'L列 Private Const 開始行 As Long = 16 Private Const 特定文字列群 As String = "破棄,保管" Public Sub 期限切れチェック() Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets(1) Dim 最終行 As Long 最終行 = 日付列の最終行取得(sht) Dim 期限切れ行 As Collection Set 期限切れ行 = 期限切れ行取得(sht, 最終行) If 期限切れ行.Count = 0 Then MsgBox "期限切れがありません。終了します。", vbInformation Exit Sub End If Dim 入力値 As String Dim 行 As Variant For Each 行 In 期限切れ行 Do 入力値 = InputBox(表示メッセージ(sht, 行)) Select Case True Case 入力値 = vbNullString: Exit For 'キャンセル Case Not IsDate(入力値): MsgBox "日付ではありません", vbExclamation Case DateDiff("d", 入力値, Now()) < 0: MsgBox "期限切れです", vbExclamation Case Else: Exit Do End Select Loop sht.Cells(行, 更新列).Value = 入力値 Next End Sub Private Function 日付列の最終行取得(ByVal sht As Worksheet) As Long 日付列の最終行取得 = sht.Cells(sht.Rows.Count, 日付列).End(xlUp).Row End Function Private Function 期限切れ行取得(ByVal sht As Worksheet, ByVal 最終行 As Long) As Collection Dim i As Long Dim n As Long Dim セル値 As String Dim c As New Collection For i = 開始行 To 最終行 If 特定文字列チェック(sht.Cells(i, チェック列).Value) = False Then セル値 = sht.Cells(i, 日付列).Value If IsDate(セル値) Then n = DateDiff("d", セル値, Now()) If n > 0 Then c.Add n End If End If End If Next Set 期限切れ行取得 = c End Function Private Function 表示メッセージ(ByVal sht As Worksheet, ByVal 表示行 As Long) As String Dim msg As String msg = "日付を更新してください。" & vbCrLf & _ "名称:" & sht.Cells(表示行, 名称列).Value & vbCrLf & _ "日付:" & sht.Cells(表示行, 日付列).Value 表示メッセージ = msg End Function Private Function 特定文字列チェック(ByVal チェックする文字列 As String) As Boolean Dim flg As Boolean Dim 特定文字列 As Variant For Each 特定文字列 In Split(特定文字列群, ",") If 特定文字列 = チェックする文字列 Then flg = True Exit For End If Next 特定文字列チェック = flg End Function （tkit） 2021/12/23(木) 11:57 ---- ＞今回追加のご質問 追加でする事は、簡単です。 （tkit）さんが書いてくださったコードの一部からヒントを探して IF文を追加して…「 ちょちょちょいっ 」とするだけです。 (-∀-) ＞教えて頂いたコードが難しく、読み解くことができず再びご質問させてください 以前にここの回答者の大先輩が言っていた事ですが… 理解できないコードは使用してはいけません。と厳しくおっしゃっていました。 なので…ご自身で多分「 こ〜して。。。あ〜すれば 」できそうな処まで コードを追加してみてください。間違っていてもそれは大丈夫なので 出来たら掲示してください。エラーで動かなくても良いので、努力する事が重要です。 因みに、修正するのは...UserForm_Initialize の方だけです。 と...CommandButton1_Clickの方のコードを一部修正しました。 Private Sub CommandButton1_Click() Dim i As Long Dim MaxRow As Long Dim ws As Worksheet Dim x As String, tmp As String Const START_COL = 1& Set ws = Sheets(1) MaxRow = ws.Cells(Rows.Count, START_COL).End(xlUp).Row For i = 1 To 10 If Me.Controls("Label" & i).Caption <> "" Then x = Me.Controls("Label" & i).Caption tmp = WorksheetFunction.Match(x, Range("A16:A" & MaxRow), 0) ws.Range("I" & tmp + 15).Value = Format(Me.Controls("TextBox" & i), "yyyy/m/d") End If Next Unload Me End Sub では、また数日後に…頑張ってください o(*'▽'*)/ （あみな） 2021/12/23(木) 20:50 ---- ＞TODAYより過ぎた日付を探す列 … I ＞更新後の日付を入力する列 …H ・よ〜く見ていませんでした。上記で確定ですね。 間違い ws.Range("I" & tmp + 15).Value = Format(Me.Controls("TextBox" & i), "yyyy/m/d") 訂正 ws.Range("H" & tmp + 15).Value = Format(Me.Controls("TextBox" & i), "yyyy/m/d") ・UserForm_Initialize の方はご自身で調整して出来たって事ですね? （あみな） 2021/12/24(金) 14:00 ---- tkit様、ご提案とコードの記述ありがとうございます。 Inputboxを初めて知りました。 ユーザーフォームでどうにかしようとしなくても上記コードで期限切れおよび セルへの転写ができるんですね。 提案および丁寧なコードをありがとうございます。 上記コードを標準モジュールに張り付けてみたところ、 期限切れの確認は問題なく実行できました。 ありがとうございます。 ですが、 msg = "日付を更新してください。" & vbCrLf & _ "名称:" & sht.Cells(表示行, 名称列).Value & vbCrLf & _ "日付:" & sht.Cells(表示行, 日付列).Value のコードを実行すると sht.Cells(表示行, 名称列)およびsht.Cells(表示行, 日付列)が表示されません。 また、sht.Cells(行, 更新列).Value の入力先のセルがH712となってしまい、 該当の名称列(A列)のH列へ入力されません。 上記で述べた通り、Inputboxを初めて知ったので、 これから内容を読み解いていきます。 また何か不明点がありましたら再びこちらにてご質問させてください。 以上、よろしくお願いします。 （マカロニ） 2021/12/24(金) 15:38 ---- あみな様、再びのコメントありがとうございます。 理解できないコードは使用してはいけません。>>>激しく同意しました。 その通りですね!!! なので、 ＜今回追加のご質問＞ 破棄または保管など特定の文字が入力される列 … L を無くします!!!! 入力があればその行を別シートへ自動的に切り取って画面上もスッキリ!!!!! という Private Sub Worksheet_Change(ByVal Target As Range) にてコードを記述しました。 ただ、再びのご質問で大変恐縮なのですが、 Format(Me.Controls("TextBox" & i), "yyyy/m/d") にて 日付を入力していない状態で実行すると、 "Label"と一致した行のH列が空白として処理されてしまい、 もともと入力されていた日付が消えてしまいます。。。 こちらもif文でIf textbox_value = "" Thenとして 分岐すればよろしいのでしょうか。 何度も何度も申し訳ございません。 再びコードとにらめっこしてきます。 （マカロニ） 2021/12/24(金) 15:51 ---- ＞sht.Cells(表示行, 名称列)およびsht.Cells(表示行, 日付列)が表示されません。 原因が分かりました。 期限切れ行取得に問題がありました。 行数を取得すべきところ、日付差を取得していました。 修正して確認してください。 （tkit） 2021/12/24(金) 17:02 ---- ・課題Aとする ＞破棄または保管など特定の文字が入力される列 … L ＞を無くします!!!! あら?変更しちゃったのですね。 L列はあっても良い気がするんですけどね? 使用者の画面前部が見えないので断定はできませんが... ま〜一様L列がある場合を書いたので上げます。 ・課題Bとする ＞日付を入力していない状態で実行すると、 ＞"Label"と一致した行のH列が空白として処理されてしまい、 ＞もともと入力されていた日付が消えてしまいます。。。 うん、そうですね。そこをど〜するんかなと? 質問をしようとしてました。 L列がある場合の完成コード（ 課題A ）と、（ 課題B ）用回避の途中まで & Sample付の のコードを掲示します。 尚、Sampleは、他のSample1〜8も付録で付いてます。（ 笑 ） 指定日付けのI列が多いと、Sample1 の実行は大変かもですが BOOKを複製して、行を20行程度にしてSample1〜7を試してみてください。 ※L列が破棄となっていた為、行削除をするコードも付録であります。 行を削除は、質問が追加で来そうなので先回りしました。(-∀-) テストは必ずBOOKを複製して、試してみてください。 今から外食の準備と、今夜はお酒が入るのでもう何もできません。(〃'∇'〃)ゝエヘヘ 年末で明日から忙しいので出来るかわかりませんが...ご自身でもトライしてみてください。 ちょっと長くなりますが... ◇（ 課題A ）L列がある場合の完成コード Private Sub UserForm_Initialize() Dim i, cnt As Long Dim MaxRow As Long Dim ws As Worksheet Dim x As String, tmp As String, Lp As String Dim Overdue(1 To 10) As String Set ws = Sheets(1) Const START_COL = 9& Const First_Condition As String = "破棄" Const Second_Condition As String = "保管" MaxRow = ws.Cells(Rows.Count, START_COL).End(xlUp).Row On Error GoTo Err For i = 16 To MaxRow If IsDate(Cells(i, START_COL).Value) Then x = Cells(i, START_COL).Value Lp = Cells(i, START_COL).Offset(, 3).Value If x <= Range("B3").Value Then If First_Condition <> Lp And Second_Condition <> Lp Then cnt = cnt + 1 Overdue(cnt) = Cells(i, START_COL).Address _ (RowAbsolute:=False, ColumnAbsolute:=False) Me.Controls("Label" & cnt).Caption = Cells(i, START_COL).Offset(, -8) End If End If End If Next If cnt <> 0 Then For i = 1 To cnt tmp = tmp & Overdue(i) & vbCrLf Next MsgBox "期限切れがあります" & vbCrLf _ & tmp, vbInformation Else: MsgBox "期限切れはありません" End If Exit Sub Err: MsgBox "期限切れが、10件以上あります" Err.Clear End Sub ◇（ 課題B ）用回避の途中までコード Private Sub UserForm_Initialize() '' Sample_1〜4 Dim i, cnt As Long Dim MaxRow As Long Dim ws As Worksheet Dim RetMsg As VbMsgBoxResult '' Sample_4 用変数追記 Dim x As String, tmp As String, Lp As String Dim Overdue(1 To 10) As String '' 期限切れ Set ws = Sheets(1) Const START_COL = 9& Const First_Condition As String = "破棄" Const Second_Condition As String = "保管" MaxRow = ws.Cells(Rows.Count, START_COL).End(xlUp).Row On Error GoTo Err For i = 16 To MaxRow If IsDate(Cells(i, START_COL).Value) Then x = Cells(i, START_COL).Value Lp = Cells(i, START_COL).Offset(, 3).Value '' Sample_1 ' MsgBox x '' ステップ実行の替り If x <= Range("B3").Value Then If First_Condition <> Lp And Second_Condition <> Lp Then cnt = cnt + 1 '' Sample_2 ' MsgBox cnt Overdue(cnt) = Cells(i, START_COL).Address _ (RowAbsolute:=False, ColumnAbsolute:=False) Me.Controls("Label" & cnt).Caption = Cells(i, START_COL).Offset(, -8) '' Sample_3 ' Debug.Print x '' 期限切れ日付けを、イミディエイトウィンドウへ表示(抽出) End If End If End If Next RetMsg = MsgBox _ (" L列に、''破棄''と記載されていますが" & vbCrLf & _ " どうしますか?" & vbCrLf & _ vbCrLf & _ " 『 はい 』 を押すと、行を一括削除します" & vbCrLf & _ " 『 いいえ 』 を押すと、何もしません", vbYesNo + vbInformation, Title:="INFO") Select Case RetMsg Case vbYes '' Sample_4 ''Callして、標準モジュールへ( First_Condition=''破棄'' )をByValで値を渡す Call Bulk_Deletion(First_Condition) '' ''破棄''の入力された行を一括削除 Case vbNo End Select If cnt <> 0 Then For i = 1 To cnt tmp = tmp & Overdue(i) & vbCrLf Next MsgBox "期限切れがあります" & vbCrLf _ & tmp, vbInformation Else: MsgBox "期限切れはありません" End If Exit Sub Err: MsgBox "期限切れが、10件以上あります" Err.Clear End Sub Private Sub CommandButton1_Click() '' Sample_5〜8 Dim i As Long Dim MaxRow As Long Dim ws As Worksheet Dim ChangeData As String '' Sample_7 用変数追記 Dim x As String, tmp As String Dim RetMsg As VbMsgBoxResult '' Sample_8 用変数追記 Const START_COL = 1& Set ws = Sheets(1) MaxRow = ws.Cells(Rows.Count, START_COL).End(xlUp).Row RetMsg = MsgBox _ (" H列を '' 更新 '' しますが、TextBox に入力が無いと...???" & vbCrLf & _ " 以前に入力された '' 更新日付け '' が空白になりますが、どうしますか?" & vbCrLf & _ vbCrLf & _ " 『 はい 』 を押すと、H列の日付けを更新します" & vbCrLf & _ " 『 いいえ 』 を押すと、H列に日付けが入力されている箇所は更新しません" & vbCrLf & _ vbCrLf & _ " 『 キャンセル 』 を押すと、何もしません", _ vbYesNoCancel + vbInformation, Title:="INFO") Select Case RetMsg Case vbYes For i = 1 To 10 If Me.Controls("Label" & i).Caption <> "" Then x = Me.Controls("Label" & i).Caption tmp = WorksheetFunction.Match(x, Range("A16:A" & MaxRow), 0) ws.Range("H" & tmp + 15).Value = Format(Me.Controls("TextBox" & i), "yyyy/m/d") '' Sample_5 '' 対象行を検索 '' 範囲内の行を1行目として数える ' MsgBox tmp '' Sample_6 '' 検索値の行を、イミディエイトウィンドウへ表示 ' Debug.Print tmp + 15 '' Sample_7 '' TextBoxへ日付けを入力後に一括変更 ' ChangeData = Format(Me.Controls("TextBox" & i), "yyyy/m/d") ' MsgBox ChangeData End If Next Unload Me Case vbNo '' Sample_8 '' Call Sample_8 Case vbCancel MsgBox "さようなら" Unload Me End Select End Sub ▼標準モジュールへ Option Explicit Sub Bulk_Deletion(ByVal First_Condition As String) '' Sample_4 '' 変数の『 First_Condition 』に、格納されている内容を確認する MsgBox First_Condition Dim i As Long Dim MaxRow As Long MaxRow = Cells(Rows.Count, 12).End(xlUp).Row Application.DisplayAlerts = False With ActiveSheet For i = MaxRow To 16 Step -1 If InStr(Cells(i, 12), First_Condition) >= 1 Then '行削除 .Rows(i).Delete End If Next End With Application.DisplayAlerts = True End Sub Sub Sample_8() MsgBox "できるかにゃ?" ここに回避用を作成する もしくはCommandButton1_Clickの方にするか? End Sub ※Sample は、コメントアウトを外して実行をしてみてください。 尚、既に理解しているのであればする必要はありませ〜ん。 ※と標準モジュールへの分岐は、ユーザーフォームばっかりだと コードがいっぱいになってしますので標準モジュールさんに応援してもらうだけです。 （あみな） 2021/12/24(金) 17:27 ---- ＞こちらもif文でIf textbox_value = "" Thenとして ＞分岐すればよろしいのでしょうか。 昨日の続きです。 Private Sub CommandButton1_Click() の回避編(抜粋) Select Case RetMsg Case vbYes For i = 1 To 10 '' セルに入力済みの日付けは削除されるコード If Me.Controls("Label" & i).Caption <> "" Then x = Me.Controls("Label" & i).Caption tmp = WorksheetFunction.Match(x, Range("A16:A" & MaxRow), 0) ws.Range("H" & tmp + 15).Value = Format(Me.Controls("TextBox" & i), "yyyy/m/d") End If Next Unload Me Case vbNo For i = 1 To 10 '' TextBox に入力が無い場合は、セルに反映させないコード If Me.Controls("Label" & i).Caption <> "" Then x = Me.Controls("Label" & i).Caption tmp = WorksheetFunction.Match(x, Range("A16:A" & MaxRow), 0) If Me.Controls("TextBox" & i).Value <> "" Then ws.Range("H" & tmp + 15).Value = Format(Me.Controls("TextBox" & i), "yyyy/m/d") End If End If Next Unload Me Case vbCancel MsgBox "さようなら" Unload Me End Select 基本これでもいいのだけれども…う〜んなんか美しくない(笑) あっ、勿論MsgBoxで分岐する必要もないので、とっぱらって使用してもらえばいいのですが と言うことで…もういっちょ UserForm_Initialize へH列の日付けの更新が入っている場合は、TextBox へ反映させて TextBox が空白なら、まだ更新日を入力されてないのがスグに判る方が使い勝手が良いのでは ないかと考えるのですがどうでしょうか? 入力されているセルの日付けは、ボタンを押すともう1っ回擦ることになりますが 一行追加するだけです。 Me.Controls("TextBox" & cnt).Value = Format(Cells(i, START_COL).Offset(, -1), "yyyy/m/d") ではでは...頑張って検証してみてください o(*'▽'*)/ （あみな） 2021/12/25(土) 22:01 ---- あみな様、多くのご教授ありがとうございます!!! For i = 16 To MaxRow If IsDate(Cells(i, START_COL).Value) Then x = Cells(i, START_COL).Value Lp = Cells(i, START_COL).Offset(, 3).Value If x <= Range("B3").Value Then If First_Condition <> Lp And Second_Condition <> Lp Then cnt = cnt + 1 ☆ Me.Controls("TextBox" & cnt).Value = Format(Cells(i, START_COL).Offset(, -1), "yyyy/m/d") Overdue(cnt) = Cells(i, START_COL).Address _ (RowAbsolute:=False, ColumnAbsolute:=False) Me.Controls("Label" & cnt).Caption = Cells(i,START_COL).Offset(, -8) End If End If End If Next ご提案して頂いた通り、ユーザーフォームを立ち上げたときに既に日付をテキストボックスへ表示させるコードを追加【☆】したことで、空白になる問題は無事解決しました!! あと一つ最後になりますが、 Private Sub UserForm_Initialize() …処理… Else: MsgBox "期限切れはありません" End If Exit Sub とあります。 期限切れが無いときは、ユーザーフォームを立ち上げず強制終了するコードを作成しました。 Else: MsgBox "期限切れはありません" Call マクロ終了 ・標準モジュール Sub マクロ終了() End End Sub 標準モジュールのプロシージャを呼び出しで、 動作を終了にしています。 コードの入力はスマートではないと思いますが、 なんとかユーザーフォームが立ち上がらずmsgboxが表示されて終了することができました。 長々と年度をまたいでまでお付き合いして頂きありがとうございました。 （マカロニ） 2022/01/05(水) 14:26 ---- ＞コードの入力はスマートではないと思いますが、 ＞なんとかユーザーフォームが立ち上がらずmsgboxが表示されて終了することができました。 ご自身の使いやすさの重視と、マクロを動かす事が重要なので、それでOKです。 自分でこれが良いなと思うことをすれば基本…大丈夫ですよ。 でも...End これ一行だけ?ならそのまま下記の方が多分良いかなと 思います。 Else: MsgBox "期限切れはありません" End ←これだけで 個人差はあると思いますが、標準モジュールさんの応援は十行以上とか? 別処理の場合で分けた方が理解し易いとか、Functionだけにされた方が 良いかと思います。 私も、スキルが足りないので…なんとなくそう思うだけですが…^^; と【☆】のコードはど真ん中にいれたのですかね? …使用人の好きなところへでOKなのですが cnt = cnt + 1 のすぐ下? 動きには、支障がないので良いですけど cnt = cnt + 1 Overdue(cnt) = Cells(i, START_COL).Address _ (RowAbsolute:=False, ColumnAbsolute:=False) Me.Controls("Label" & cnt).Caption = Cells(i, START_COL).Offset(, -8) Me.Controls("TextBox" & cnt).Value = Format(Cells(i, START_COL).Offset(, -1), "yyyy/m/d") End If 上記の方が、Me.Controlsを2行にして、右辺を左辺にが並んだ方が個人的には 可読性も良く、綺麗かなと思いますです。(きっと^^;) ではでは、お疲れさまでした。 （あみな） 2022/01/05(水) 23:06... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202112/20211213141600.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97004 documents and 608067 words.
訪問者：