'-------------- [UserForm6] -------------- Dim Txb As Integer 'TextBox1(出席番号) Dim r As Long 'シート最終行 Dim Fnd As Range '検索セル Dim Cln As Long 'セル行ナンバー Dim Cmb As Integer 'コンボナンバー Dim Sbn As Integer 'スクロールナンバー Private Sub ComboBox1_Change() '科目選択 If ComboBox1.Text = "" Then TextBox3.Value = "" Exit Sub End If Cmb = ComboBox1.ListIndex 'コンボリスト設定 Txb = Val(TextBox1.Value) 'TextBox1(出席番号) r = Worksheets(1).Rows.Count 'シート最終行 If TextBox1.Value <> "" Then With Worksheets(1).Range("A:A") Set Fnd = .Find(Txb, LookIn:=xlValues) '検索セル 'もし見つからなければレコード最終行の次の行 If Fnd Is Nothing Then Cells(r, 1).End(xlUp).Offset(1).Select Cln = Val(Mid(Selection.Address(), 4, 3)) Else 'もし見つかればセル行ナンバー検出 Cln = Val(Mid(Fnd.Address(), 4, 3)) End If End With '点数を TextBox3 に転記 TextBox3.Value = Range(Chr((Cmb + 64 + 3)) & Cln).Value Else TextBox3.Value = "" End If End Sub '-------------------------------------------------- Private Sub CommandButton1_Click() '値確定 If ComboBox1.Text = "" Then Exit Sub Cmb = ComboBox1.ListIndex Txb = Val(TextBox1.Value) 'TextBox1(出席番号) r = Worksheets(1).Rows.Count 'シート最終行 If TextBox1.Value <> "" Then With Worksheets(1).Range("A:A") Set Fnd = .Find(Txb, LookIn:=xlValues) '検索セル 'もし見つからなければレコード最終行の次の行 If Fnd Is Nothing Then Cells(r, 1).End(xlUp).Offset(1).Select Cln = Val(Mid(Selection.Address(), 4, 3)) Else 'もし見つかればセル行ナンバー検出 Cln = Val(Mid(Fnd.Address(), 4, 3)) End If End With '点数をシートセルに転送 If TextBox3.Value <> "" Then Range(Chr((Cmb + 67)) & Cln).Value = _ Val(TextBox3.Value) Else Range(Chr((Cmb + 67)) & Cln).Value = "" End If TextBox3.SetFocus End If '次の出席番号を TextBox1 に入れる TextBox1.Value = Range("A" & CStr(Sbn + 1)) + 1 End Sub '-------------------------------------------------- Private Sub CommandButton1_KeyUp(ByVal KeyCode As MSForms. _ ReturnInteger, ByVal Shift As Integer) 'エンターキーを TextBox3 内で押した時、 'フォーカスを CommanButton1 に行かせず 'に TextBox3 内に留めておく。 If KeyCode = 13 Then TextBox3.SetFocus End Sub '-------------------------------------------------- Private Sub CommandButton2_Click() '値訂正 If ComboBox1.Text = "" Then Exit Sub Cmb = ComboBox1.ListIndex Txb = Val(TextBox1.Value) 'TextBox1(出席番号) r = Worksheets(1).Rows.Count 'シート最終行 If TextBox1.Value <> "" Then With Worksheets(1).Range("A:A") Set Fnd = .Find(Txb, LookIn:=xlValues) '検索セル 'もし見つからなければレコード最終行の次の行 If Fnd Is Nothing Then Cells(r, 1).End(xlUp).Offset(1).Select Cln = Val(Mid(Selection.Address(), 4, 3)) Else 'もし見つかればセル行ナンバー検出 Cln = Val(Mid(Fnd.Address(), 4, 3)) End If End With 'データ消去 Range(Chr((Cmb + 67)) & Cln).Value = "" TextBox3.Value = "" TextBox3.SetFocus End If End Sub '-------------------------------------------------- Private Sub CommandButton3_Click() '閉じる Unload UserForm6 End Sub '-------------------------------------------------- Private Sub ScrollBar1_Change() 'スクロールバー値に対応するシートセルに '入っている出席番号を TextBox1 に渡す Sbn = ScrollBar1.Value TextBox1.Value = Range("A" & CStr(Sbn + 1)) End Sub '-------------------------------------------------- Private Sub TextBox1_Change() '番号の手処理にも対応 Cmb = ComboBox1.ListIndex Txb = Val(TextBox1.Value) 'TextBox1(出席番号) r = Worksheets(1).Rows.Count 'シート最終行 If TextBox1.Value <> "" Then With Worksheets(1).Range("A:A") Set Fnd = .Find(Txb, LookIn:=xlValues) '検索セル 'もし見つからなければレコード最終行の次の行 If Fnd Is Nothing Then Cells(r, 1).End(xlUp).Offset(1).Select Cln = Val(Mid(Selection.Address(), 4, 3)) Else 'もし見つかればセル行ナンバー検出 Cln = Val(Mid(Fnd.Address(), 4, 3)) End If End With 'データをボックスに転記 TextBox2.Value = Range("B" & Cln).Value If Cmb <> -1 Then TextBox3.Value = Range(Chr((Cmb + 67)) & Cln).Value Else TextBox3.Value = "" End If 'スクロールバーと TextBox1 を連動 If (Cln - 1) <= ScrollBar1.Max Then ScrollBar1.Value = (Cln - 1) '(セル行 - 1) Else Beep 'データ行数をオーバー Exit Sub End If TextBox3.SetFocus Else TextBox2.Value = "" TextBox3.Value = "" ComboBox1.ListIndex = -1 End If End Sub '-------------------------------------------------- Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms. _ ReturnInteger, ByVal Shift As Integer) 'エンターキーに対応 If KeyCode = 13 Then '値確定 If ComboBox1.Text = "" Then Exit Sub Cmb = ComboBox1.ListIndex Txb = Val(TextBox1.Value) 'TextBox1(出席番号) r = Worksheets(1).Rows.Count 'シート最終行 If TextBox1.Value <> "" Then With Worksheets(1).Range("A:A") Set Fnd = .Find(Txb, LookIn:=xlValues) '検索セル 'もし見つからなければレコード最終行の次の行 If Fnd Is Nothing Then Cells(r, 1).End(xlUp).Offset(1).Select Cln = Val(Mid(Selection.Address(), 4, 3)) Else 'もし見つかればセル行ナンバー検出 Cln = Val(Mid(Fnd.Address(), 4, 3)) End If End With '点数をシートセルに転送 If TextBox3.Value <> "" Then Range(Chr((Cmb + 67)) & Cln).Value = _ Val(TextBox3.Value) Else Range(Chr((Cmb + 67)) & Cln).Value = "" End If End If '次の出席番号を TextBox1 に入れる TextBox1.Value = Range("A" & CStr(Sbn + 1)) + 1 End If End Sub '-------------------------------------------------- Private Sub UserForm_Initialize() '初期設定 Dim kamoku As Range Dim Lr, Lc As Integer Lr = Range("A1").End(xlDown).Row 'データ最終行 Lc = Range("A1").End(xlToRight).Column 'データ最終列 '初期位置 'Me.StartUpPosition = 0 ' Me.Top = 200 ' Me.Left = 27 'コンボボックスに科目名を表示 With ComboBox1 For Each kamoku In ActiveSheet. _ Range("C1:" & Chr(Lc + 64) & "1") _ .SpecialCells(xlCellTypeVisible) .AddItem kamoku.Value Next .ListIndex = -1 '最初空欄 End With 'ボックスに初期値設定 TextBox1.Value = Range("A2").Value TextBox2.Value = Range("B2").Value TextBox3.Value = "" 'スクロールボタンの最大最小値の設定 With ScrollBar1 .Min = 1 .Max = Lr - 1 'データ数 End With End Sub '-------------------------------------------------- back top