Results of 1 - 1 of about 13159 for 日付 (0.003 sec.)
- [[20180105233753]]
- #score: 2423
- @digest: 9280b35b0638b537c588f2b595efb8f5
- @id: 75190
- @mdate: 2018-01-07T04:45:01Z
- @size: 13282
- @type: text/plain
- #keywords: 物列 (57478), 約中 (48319), 約-" (38744), 付行 (34761), 消ボ (29523), 全履 (28429), 予約 (28238), 品物 (22774), combobox4 (20661), 行先 (15073), combobox2 (10372), 取消 (9837), matchbyte (8031), searchformat (7362), searchdirection (6921), tintandshade (6587), 貸出 (6128), searchorder (5485), 行1 (5422), 行2 (5275), textbox3 (5084), combobox3 (5027), userform2 (4941), xlbyrows (4860), xlnext (4771), textbox2 (4622), formular1c1 (4363), activecell (4269), matchcase (3756), textbox1 (3715), text (2929), 履歴 (2914)
- 『ユーザーフォーム ボタンクリック後、人によるセルの選択、その内容をファームに返す方法』（なか）
シート内に上段に品物、A列に日付があり。 その品物と日付が、交わるところに名前を入れる貸し出し表を作成してます。 予約、貸出はボタンから自動で名前が入るように作れたのですが、取消ボタンを作りたくおもっています。 イメージとしては、ユーザーフォームにて取消ボタンをクリックすると、メッセージボックスで、取り消したい日にちと品物の名前を選択とでるので、シート内の取り消したい日付と品物が交わる名前を、クリックするとその日付と品物がユーザーフォームに帰ってきて、確認後、取消実行ボタンで、名前を消す作業をしたく思ってます。 途中で人の介入をいれるということができるのでしょうか? いつでもそのセルをクリックしたらマクロが実行されても困るので、アイディアを、いただけたらと存じます。 どうぞよろしくお願いします。 ＜ 使用 Excel:Excel2007、使用 OS:Windows8 ＞ ---- Application.InputBox メソッド(InputBox関数ではなく）のType:=8 を指定して、 ユーザーにセル範囲の指定を求めることができます。 これを利用してみてはどうですか? # されたいことが十分理解できていませんが。 （γ） 2018/01/06(土) 07:43 ---- ＞予約、貸出はボタンから自動で名前が入るように作れたのですが、 それは、どのようなコードでしょうか。 ＞取消ボタンを作りたくおもっています。 ＞取消実行ボタンで、名前を消す作業をしたく思ってます。 名前を、空欄状態で、予約、貸出はボタンをクリックすると、 結果的に、名前は消えそうな気がしますが 違いますか。 （マナ） 2018/01/06(土) 08:21 ---- マナさまありがとうございます。 作成したマクロです。 Private Sub CommandButton1_Click() If ComboBox2 = "" Then MsgBox "部署名と名前を入力してください" Exit Sub Else End If If ComboBox4 = "" Then MsgBox "品物を選んでください" Exit Sub Else End If If TextBox3.Text = "" Then MsgBox "行先を入力してください" Exit Sub Else End If Dim shtmei As String shtmei = Me.ComboBox3.Value Sheets(shtmei).Activate If TextBox1 = TextBox2 Then Rows("1:1").Select Selection.Find(What:=ComboBox4, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False).Select Dim n As Long n = Selection.Column Columns("A:A").Select Application.FindFormat.NumberFormat = "yyyy/mm/dd" Selection.Find(What:=TextBox1, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=True).Select Dim a As Long a = Selection.Row If Cells(a, n).Value = "" Then Cells(a, n).Value = "予約-" & ComboBox2 With Cells(a, n).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 13421823 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorAccent2 .TintAndShade = -0.249977111117893 Else: MsgBox "予約中または予約中です" Cells(1, 1).Select Exit Sub End If Else: Rows("1:1").Select Selection.Find(What:=ComboBox4, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False).Select Dim p As Long p = Selection.Column Columns("A:A").Select Application.FindFormat.NumberFormat = "yyyy/mm/dd" Selection.Find(What:=TextBox1, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=True).Select Dim c As Long c = Selection.Row Rows("1:1").Select Selection.Find(What:=ComboBox4, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False).Select Dim o As Long o = Selection.Column Columns("A:A").Select Application.FindFormat.NumberFormat = "yyyy/mm/dd" Selection.Find(What:=TextBox2, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=True).Select Dim b As Long b = Selection.Row If Range(Cells(c, p), Cells(b, o)).Value = "" Then Range(Cells(c, p), Cells(b, o)).Value = "予約-" & ComboBox2 With Range(Cells(c, p), Cells(b, o)).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 13421823 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorAccent2 .TintAndShade = -0.249977111117893 End With Else: MsgBox "予約中または予約中です" Cells(1, 1).Select Exit Sub End If End If With ThisWorkbook.Worksheets("全履歴").Select Dim z As Long z = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & z).Select ActiveCell.FormulaR1C1 = "=NOW()" Range("B" & z).Select ActiveCell.FormulaR1C1 = TextBox1.Text Range("C" & z).Select ActiveCell.FormulaR1C1 = TextBox2.Text Range("D" & z).Select ActiveCell.FormulaR1C1 = ComboBox4.Text Range("E" & z).Select ActiveCell.FormulaR1C1 = "予約" Range("F" & z).Select ActiveCell.FormulaR1C1 = ComboBox1.Text Range("G" & z).Select ActiveCell.FormulaR1C1 = ComboBox2.Text Range("H" & z).Select ActiveCell.FormulaR1C1 = TextBox3.Text End With UserForm2.Hide UserForm2.StartUpPosition = 0 UserForm2.Top = Application.Top + 200 UserForm2.Left = Application.Left + 300 UserForm2.Show vbModeless Sheets(shtmei).Activate End Sub 作成しました。 γさまありがとうございます。 このようなメソッドはじめてしりました。 教えていただいたメソッドでできそうです。 複数あるシートも選択したいのですが不可能でしょうか? 後だしで申し訳ございません。よろしくお願いいたします。 （なか） 2018/01/06(土) 10:35 ---- 読みにくいので、最初のほうだけ書き直しました。 完成までに程遠いですが わたしのコメントのイメージはこういうことです。 ＞名前を、空欄状態で、予約、貸出はボタンをクリックすると、 ＞結果的に、名前は消えそうな気がしますが Private Sub CommandButton1_Click() Dim ws As Worksheet Dim 品物列, 日付行 Dim r As Range If ComboBox4.Text = "" Then MsgBox "品物を選んでください" Exit Sub End If If TextBox3.Text = "" Then MsgBox "行先を入力してください" Exit Sub End If Set ws = Sheets(ComboBox3.Text) If TextBox1.Text = TextBox2.Text Then 品物列 = Application.Match(ComboBox4.Text, ws.Rows(1), 0) 日付行 = Application.Match(CLng(CDate(TextBox1.Text)), ws.Columns(1), 0) Set r = ws.Cells(日付行, 品物列) If ComboBox2.Text <> "" Then If r.Value = "" Then r.Value = "予約-" & ComboBox2.Text r.Interior.Color = 13421823 r.Font.ThemeColor = xlThemeColorAccent2 Else MsgBox "予約中または予約中です" Application.Goto ws.Cells(1, 1) Exit Sub End If Else If r.Value <> "" Then If MsgBox("予約を取り消しますか?", vbYesNo) = vbYes Then r.ClearContents End If End If End If Else '省略 End If End Sub （マナ） 2018/01/06(土) 13:14 ---- 2/3ほどまで、書換えました。 色つけるのは、条件付き書式でよいと勝手に判断しました。 Private Sub CommandButton1_Click() Dim ws As Worksheet Dim 品物列, 日付行1, 日付行2 Dim r As Range If ComboBox4.Text = "" Then MsgBox "品物を選んでください" Exit Sub End If If TextBox3.Text = "" Then MsgBox "行先を入力してください" Exit Sub End If Set ws = Sheets(ComboBox3.Text) 品物列 = Application.Match(ComboBox4.Text, ws.Rows(1), 0) 日付行1 = Application.Match(CLng(CDate(TextBox1.Text)), ws.Columns(1), 0) 日付行2 = Application.Match(CLng(CDate(TextBox2.Text)), ws.Columns(1), 0) Set r = ws.Cells(日付行1, 品物列).Resize(日付行2 - 日付行1 + 1) If ComboBox2.Text <> "" Then If WorksheetFunction.CountA(r) = 0 Then r.Value = "予約-" & ComboBox2.Text Else MsgBox "予約中または予約中です" Application.Goto ws.Cells(1, 1) Exit Sub End If Else If WorksheetFunction.CountA(r) > 0 Then If MsgBox("予約を取り消しますか?", vbYesNo) = vbYes Then r.ClearContents End If End If End If '省略 End Sub （マナ） 2018/01/06(土) 14:09 ---- 最後の部分も書き直しました。 エラー対策は一切していませんが、 動作イメージの確認には支障ないと思います。 試してみて違うなと思えば無視してください。 Private Sub CommandButton1_Click() Dim ws As Worksheet Dim 品物列, 日付行1, 日付行2 Dim r As Range Dim z As Long If ComboBox4.Text = "" Then MsgBox "品物を選んでください" Exit Sub End If If TextBox3.Text = "" Then MsgBox "行先を入力してください" Exit Sub End If Set ws = Worksheets(ComboBox3.Text) 品物列 = Application.Match(ComboBox4.Text, ws.Rows(1), 0) 日付行1 = Application.Match(CLng(CDate(TextBox1.Text)), ws.Columns(1), 0) 日付行2 = Application.Match(CLng(CDate(TextBox2.Text)), ws.Columns(1), 0) Set r = ws.Cells(日付行1, 品物列).Resize(日付行2 - 日付行1 + 1) If ComboBox2.Text <> "" Then If WorksheetFunction.CountA(r) = 0 Then r.Value = "予約-" & ComboBox2.Text Else MsgBox "予約中または予約中です" Application.Goto ws.Cells(1, 1) Exit Sub End If Else If WorksheetFunction.CountA(r) > 0 Then If MsgBox("予約を取り消しますか?", vbYesNo) = vbYes Then r.ClearContents Else Exit Sub End If End If End If With ThisWorkbook.Worksheets("全履歴") z = .Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(z, "A").Value = Now .Cells(z, "B").Value = TextBox1.Text .Cells(z, "C").Value = TextBox2.Text .Cells(z, "D").Value = ComboBox4.Text .Cells(z, "E").Value = IIf(ComboBox2.Text <> "", "予約", "解約") .Cells(z, "F").Value = ComboBox1.Text .Cells(z, "G").Value = ComboBox2.Text .Cells(z, "H").Value = TextBox3.Text End With End Sub （マナ） 2018/01/06(土) 15:25 ---- マナさまありがとうございます。 お恥ずかしい話変数日本語が使えるとも知りませんでした。 何度も申し訳ございません。 予約と取り消しを別のボタンで行いたいと思っております。 この場合解約はどのような方法になるのでしょうか? WorksheetFunction.CountA(r) > 0 Thenの意味が分からずもうしわけございません。 （なか） 2018/01/06(土) 17:42 ---- 申し訳ありません。 実は、なぜそんなまわりくどいことするのか、よくわかっていません。 ＞イメージとしては、ユーザーフォームにて取消ボタンをクリックすると、… マクロ使わずに、セルを選択してDeleteキーを押すだけでは? （マナ） 2018/01/06(土) 18:27 ---- マナさま マナさまのマクロだと全履歴に人が残らないのです。 全履歴を確認知ればわかるのですが、できるだけ誰がどの作業をしたか履歴を残したく考えています。 予約した数日後に解約する場合。 わざわざ前回予約した日付を入力するのが手間なので、取り消したいセルをユーザにクリックしてもらおうとと考えていました。 しかしとてもシンプルなマクロになってまだまだ自分の未熟さを知りました。ありがとうございます。 （なか） 2018/01/06(土) 19:02 ---- ＞わざわざ前回予約した日付を入力するのが手間なので それならば、予約のときもセル選択方式がよいのでは? （マナ） 2018/01/06(土) 19:50 ---- 例えば、こんな感じで情報を取得します Sub test() Dim r As Range Dim 品物 As String Dim 日付1 As String Dim 日付2 As String Dim 行先 As String On Error Resume Next Set r = Application.InputBox("セル選択", Type:=8) On Error GoTo 0 If r Is Nothing Then Exit Sub 品物 = r.EntireColumn.Cells(1).Value 日付1 = r(1).EntireRow.Cells(1).Value 日付2 = r(r.Count).EntireRow.Cells(1).Value 行先 = r.Parent.Name MsgBox 品物 & vbLf & 日付1 & vbLf & 日付2 & vbLf & 行先 End Sub （マナ） 2018/01/06(土) 20:12 ---- マナさま ありがとうございます。 そうですね。逆に予約も日付で選べばいいですね。 いただいたマクロもテストしておこなってみます。 ありがとうございます。 （なか） 2018/01/07(日) 13:45... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201801/20180105233753.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608132 words.
訪問者：