Tạo form nhập dữ liệu tự động vào sheet!

[longriver28284]

Mình đang làm công tác khí tượng thủy văn, hằng ngày phải nhập dữ liệu các mực nước rất nhiều nên rất cần sự giúp đỡ.(Mình có gửi file đính kèm).
File gồm các sheet: Dong Tam, Mai Hoa, Dong Hoi, Kien Giang, Le Thuy, Tan My, Nhap vao và Tong hop.
Hiện tại, khi có số liệu mới (ở đây là Mực nước các trạm đo theo ngày và giờ) thì mình phải nhập lần lượt vào các sheet, nên rất mất thời gian, và hay bị nhầm lẫn.
Mình muốn lập một form ở sheet "Nhap vao", ở sheet này thì sẽ nhập vào: giờ, ngày và số liệu mực nước tương ứng các trạm, và các số liệu này sẽ tự động nhập vào đúng các sheet tương ứng theo ngày và giờ.
Rất mong được giúp đỡ!

 

[sealand]

Bạn xem file có đúng yêu cầu không nhé. (Mình sót chưa xóa ngày giờ sau khi nhập, bạn sửa nhé. Để nguy hiểm đấy, khi vô tình nhấn nút nhập thì toàn bộ giờ đó ngày đó =0)

 

[SA_DQ]

Thêm 1 tham khảo trong file đính kèm

Option Explicit

Sub Nhap()
 Dim Sh As Worksheet, Ngay As Range, Gio As Range, gRng As Range, nRng As Range
 Dim Jj As Byte, Clls As Range, Ten As String
  
 Sheets("Nhap vao").Select
 For Each Clls In Range([H10], [h65500].End(xlUp))
   Ten = Clls.Value
   Set Sh = Sheets(Ten)
   Set Gio = Sh.Range(Sh.[B3], Sh.[iV3].End(xlToLeft))
   Set Ngay = Sh.Range(Sh.[B3], Sh.[B65500].End(xlUp))
   Set gRng = Gio.Find([e6].Value, , xlFormulas, xlWhole)
   Set nRng = Ngay.Find([G6].Value)
   Sh.Cells(nRng.Row, gRng.Column).Value = Clls.Offset(, -1).Value
 Next Clls
End Sub

 

[sealand]

Mình bổ xung hàm kiểm tra dữ liệu nếu trống 1 ô nào đó không nhập được và sửa bài trước

Sub Nhap()
Dim ngay, gio As Integer
If Not check Then
MsgBox "Du lieu chua day du, khong nhap duoc!"
Exit Sub
End If
ngay = Sheet8.[g6]
gio = Sheet8.[e6]
Sheet1.[B3].Offset(ngay, gio) = Sheet8.[g10]
Sheet2.[B3].Offset(ngay, gio) = Sheet8.[g11]
Sheet3.[B3].Offset(ngay, gio) = Sheet8.[g12]
Sheet4.[B3].Offset(ngay, gio) = Sheet8.[g13]
Sheet5.[B3].Offset(ngay, gio) = Sheet8.[g14]
Sheet6.[B3].Offset(ngay, gio) = Sheet8.[g15]
Sheet8.Range("G10:G15").ClearContents
Sheet8.[g6] = ""
Sheet8.[e6] = ""
End Sub
'==================================
'Ham kiem tra du lieu truoc khi nhap
Function check()
check = True
With Sheet8
If .[g6] = "" Or .[e6] = "" Then
check = False
Exit Function
End If
For Each cl In Sheet8.Range("G10:G15").Cells
If cl = "" Then check = False
Next
End With
End Function

 

[longriver28284]

Thành thật cảm ơn các bạn, đúng ý của mình rồi

 

[Đào Việt Cường]

Dear longriver8284,
--------------------

Gửi tặng bạn file này, hi vọng giúp bạn thiết thực giải quyết công việc nhanh và hiệu quả.

(Lưu ý, link download có thể vô hiệu sau 90 ngày, mong các bạn thông cảm)