pho********

2022/6/17 16:30

22回答

Excelでフォーム入力をしたいと考えております。 下の画像はレッスンクラスの出欠確認票を表しています。 D列やF列などに各レッスン生の出欠状況・振替済かなどの情報を 入力しているます。

Excelでフォーム入力をしたいと考えております。 下の画像はレッスンクラスの出欠確認票を表しています。 D列やF列などに各レッスン生の出欠状況・振替済かなどの情報を 入力しているます。 出欠確認をした所をダブルクリックするとフォームが立ち上がるようには 作ったのですが、ここからレッスン日・科目・講師名を自動で読み取り、 自分で入力したテキストを出欠タブに入力したいと考えております。 例えば、 4日やまだ1さんの出欠を記入する場合、D8をダブルクリックで フォームが立ち上がり、 クラス名 (C3) 日付 (C5) 科目 (C6) 講師名 (C7) 生徒名 (C8) 11日やまだ2さんの場合は、F9をダブルクリックで、 クラス名 (C3) 日付 (E5) 科目 (E6) 講師名 (E7) 生徒名 (E9) を自動的に読み取り、 ユーザーフォーム1の 出欠・振替状況には自分でテキスト入力するようにします。 入力ボタンを押したところで、 画像下側に出している出欠タブに B列からレッスン日・氏名・クラス・科目・講師名を上から空いている行に 入力したいと考えていますが、 どのように作ればよいのか分かりません。 特に、クリックする場所によって読み取る所が違うので、一つずつVBAを描かなくては 行けないのでしょうか？ 出来れば、クラス名はセルｃ3固定ですが、 日付はクリックした場所の-1：-3の位置で、氏名は-1：0の位置を 読み取りたいのですが、どのように書けばよいか分かりません。 宜しくお願いいたします。

画像

Excel | Visual Basic・332閲覧・xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0
kky********

カテゴリマスター

2022/6/18 7:34

「ジュニアクラス」シートの5行目は日付にして下さい（表示形式でd日にする） ユーザーフォームのオブジェクト名は下記の通りとします。 クラス名：Textbox1 レッスン日：Textbox2 レッスン科目：Textbox3 氏名：Textbox4 講師名：TextBox5 出欠・振替状況：TextBox6 標準モジュールに Public wr As Range 「ジュニアクラス」シートのシートモジュール Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row < 8 Or (Target.Column <> 4 And Target.Column <> 6) Then Exit Sub Cancel = True Set wr = Target UserForm4.Show End Sub ユーザーフォームのコード Option Explicit Private Sub UserForm_Initialize() Dim r As Long, c As Integer r = wr.Row c = wr.Column Textbox1.Value = Cells(3, 3).Value Textbox2.Value = Cells(5, c - 1).Value Textbox3.Value = Cells(6, c - 1).Value Textbox4.Value = Cells(r, c - 1).Value TextBox5.Value = Cells(7, c - 1).Value End Sub Private Sub CommandButton1_Click() Dim r As Long wr.Value = TextBox6.Value With Worksheets("出欠") r = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(r, 2).Value = Textbox2.Value .Cells(r, 3).Value = Textbox4.Value .Cells(r, 4).Value = Textbox1.Value .Cells(r, 5).Value = Textbox3.Value .Cells(r, 6).Value = TextBox5.Value .Cells(r, 7).Value = TextBox6.Value .Cells(r, 1).Value = .Cells(r, 3).Value & .Cells(r, 2).Value2 End With End Sub

pho********

質問者2022/6/19 16:18

有難うございます。 表が一つの場合ならば何も問題無いのですが、 添付画像のように一つのタブに 複数のクラスがあり、表を使っています。 その場合、 右はTarget.Column <> 4 を増やしたり、 下はIf Target.Row < 8 Orとf Target.Row > 19 Or If Target.Row < 31 Orとf Target.Row > 42 Or で対応させたのですが、その場合 UserForm1を描くクラスごとに作らないとだめなのでしょうか？ 宜しくお願いいたします。

画像

ThanksImg質問者からのお礼コメント

こちらからの回答がなかなかできず、申し訳ありませんでした。 私の方が質問に答えるのに時間がかかってしまい、 解決までできませんでしたが、改めて質問させていただきますので よろしければ、よろしくお願いいたします。

お礼日時：6/23 19:14

その他の回答（1件）

0
qgl********

2022/6/18 11:36

こんな感じです。 ※フォームについては添付図を参照してください。 機能：①「ジュニアクラス」シートのＢ列又はＤ列の８行目以降のセルをダブルクリックすると、関係するデータがフォームに取得されます。 ②フォームのデータに間違いがないかを確認し、問題がなければ「入力」ボタンを押して「出欠」シートの該当位置に転記します。 ■フォーム構成 TextBox1：クラス名 TextBox2：レッスン日 TextBox3：レッスン科目 TextBox4：出欠・振替状況 TextBox5：氏名 TextBox6：講師名 CommandButton1：入力 CommandButton2：終了(キャンセル) ■「ジュニアクラス」シートのBeforeDoubleClickイベント Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) If Intersect(target, Range("B:B", "D:D")) Is Nothing Then Exit Sub Else If target.Count > 1 Then Exit Sub Else Application.EnableEvents = False If target.Row > 7 Then Select Case target.Column Case 2 Call FormGet(2, target) Case 4 Call FormGet(4, target) End Select End If Application.EnableEvents = True End If End If End Sub Sub FormGet(ByVal x As Long, ByVal target As Range) With UserForm1 .TextBox1.Value = Replace(Cells(3, 2), "クラス", "") 'クラス名 .TextBox2.Value = Cells(5, x) 'レッスン日 .TextBox3.Value = Cells(6, x) 'レッスン科目 .TextBox4.Value = target.Offset(, 1).Value '出欠・振替状況 .TextBox5.Value = target.Value '氏名 jname = target.Value .TextBox6.Value = Cells(7, x) '講師名 End With UserForm1.Show End Sub ■フォームモジュール Option Explicit '入力 Private Sub CommandButton1_Click() Dim i As Long, r As Long Worksheets("出欠").Select With Worksheets("出欠") r = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To r If .Cells(i, "C") = jname And .Cells(i, "D") = "" Then .Cells(i, "D") = UserForm1.TextBox1.Value .Cells(i, "E") = UserForm1.TextBox3.Value .Cells(i, "F") = UserForm1.TextBox6.Value .Cells(i, "G") = UserForm1.TextBox4.Value End If Next i End With Unload UserForm1 End Sub '終了 Private Sub CommandButton2_Click() Unload UserForm1 End Sub

画像