Trợ giúp nhập liệu "giờ" vào trong worksheet

[levanduyet]

Đôi khi các bạn cần nhập giờ vào trong một vùng của một sheet, các bạn muốn:
_ Nhập vào 12 thì công cụ sẽ giúp định dạng ô hiện tại và nhập vào 12:00
_ Nhập vào 1 thì công cụ sẽ giúp định dạng ô hiện tại và nhập vào 01:00
_ Nhập vào 430 thì công cụ sẽ giúp định dạng ô hiện tại và nhập vào 04:30
_ Nếu nhập vào 678 thì công cụ sẽ báo sai vào không cho nhập vào.

Đúng là thật rắc rối nhỉ! Để xử lý tốt số liệu, chúng ta sẽ dùng một Textbox để bắt buộc người dùng nhập vào Textbox này. Sau khi đã bắt buộc người dùng nhập vào Textbox này, chúng ta sẽ dễ dàng sử dụng các Even của Textbox này để xử lý số liệu trước khi định dạng và đưa vào Excel. Đầu tiên các bạn hãy đặt một Textbox lên worksheet của bạn và đặt tên là txtDataEntry. Chúng ta hãy dùng sự kiện

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

để cho Textbox này hiện hay không?

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
   On Error Resume Next 
   Application.ScreenUpdating = False 
   If Not Intersect(Range("tbTest"), Target) Is Nothing Then 
      'Set Visible=True to see the textbox
      txtDataEntry.Visible = True 
      'Set the size of textbox
      With txtDataEntry 
         .Height = Target.Height 
         .Width = Target.Width 
         .Top = Target.Top 
         .Left = Target.Left 
         .TextAlign = fmTextAlignCenter 
         .Activate 
      End With 
   Else 
      txtDataEntry.Visible = False 
   End If 
   Application.ScreenUpdating = True 
End Sub

Sau đó chúng ta sẽ dựa vào sự kiện

Private Sub txtDataEntry_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

để chỉ cho người dùng nhập vào số, và không được dài hơn 4 ký tự.

Private Sub txtDataEntry_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 
   If Len(txtDataEntry.Text) < 4 Then 
      If KeyAscii >= 48 And KeyAscii <= 57 Then 
         'Do nothing
      Else 
         KeyAscii = 0 
      End If 
   Else 
      KeyAscii = 0 
   End If 
End Sub

Bây giờ chúng ta sẽ dựa vào sự kiện KeyDown để xử lý dữ liệu và đưa vào worksheet

Private Sub txtDataEntry_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Private Sub txtDataEntry_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 
   Dim sTemp$ 
   Application.ScreenUpdating = False 
   Select Case KeyCode 
   Case vbKeyReturn 
      ActiveCell.NumberFormat = "hh:mm" 
      On Error Resume Next 
      sTemp = txtDataEntry.Text 
      If Len(sTemp) = 1 Then 
         sTemp = "0" & sTemp & "00" 
      ElseIf Len(sTemp) = 2 Then 
         sTemp = sTemp & "00" 
      ElseIf Len(sTemp) = 3 Then 
         sTemp = "0" & sTemp 
      End If 
      ActiveCell.Value = CDate(Format$(sTemp, "00:00")) 
      If Err.Number = 13 Then 
         MsgBox "Ban da nhap sai. Xin kiem tra lai.", vbOKOnly, "Thong bao" 
         Exit Sub 
      End If 
      On Error GoTo 0 
      txtDataEntry.Text = "" 
      ActiveCell.Offset(1, 0).Select 
   Case vbKeyTab, vbKeyRight 
      ActiveCell.Offset(0, 1).Select 
   Case vbKeyUp 
      ActiveCell.Offset(-1, 0).Select 
   Case vbKeyDown 
      ActiveCell.Offset(1, 0).Select 
   Case vbKeyLeft 
      ActiveCell.Offset(0, -1).Select 
   Case Else 
      'MsgBox KeyCode
   End Select 
   Application.ScreenUpdating = True 
End Sub

Chú ý: vùng tôi muốn nhập liệu có tên là tbTest
Chúc các bạn thành công.

Lê Văn Duyệt