Như đã nêu ở trên file mình làm việc hằng ngày là file do cty lập sẳn nó khoá hết toàn bộ chức năng và chỉ cho ta thao tác trên nhưng ô không khoá thôi và mình cũng không đc quền thêm sheet vào. Hằng giờ phải lọc dư liệu trên mail và đưa dử liệu vào file đó sử lý số liệu rồi lại mail cho phòng ban khác . Mình viết vba cho mọi người trong phòng cùng sai. Để cho những người không biết nhiều về excel cũng dùng đc nhằm giảm tối đa những sai sót khi nhập liệu .
Họ có y cũa họ và mình cũng có ý cũa mình moa, có góp ý rồi nhưng kg thấy họ phản hồi gì cũng đành chịu. Hôi mình mới vào làm việc thấy các cụ trong phòng nhập số liệu vào file theo phương thức bằng tay nhình mà chán đời thôi rồi mất cả 30 phút nhập số liệu mà còn sai tùm lum, mình đã làm lại cho phòng vài thứ bây giờ đã cải thiện nhiều rồi nhưng vẫn còn nhiều sai sót .
Tôi chỉ góp ý vậy thôi, còn công việc thì phải từ từ.
Sub CommandButton1_Click()
Dim DataObj As MSForms.DataObject
'----Ham nay lay data tu Clipboard
Dim MyString As Variant
Dim MyS As String
Dim x As Integer, i As Integer
Dim text As String, Editext As String
Dim icount As Long
Dim n As Integer
Dim ar As Variant
Dim Ghep As String
Set DataObj = New MSForms.DataObject
On Error GoTo Whoa
DataObj.GetFromClipboard
MyString = DataObj.GetText(1)
MsgBox MyString
[I21] = MyString
'-- khong co du lieu vao day
Whoa:
If Err <> 0 Then MsgBox "Khong co du lieu trong Clipboard"
text = Trim([I21]) '(( neu la mot [321 3213 3213 3213 3213] thi hame chay tot
' dem chuoi
' lan sau dung Funtion WorkSheetFuntion SubTitute // ham excel
x = DemKT(text) + 1 ' dem so khoang trang
Debug.Print x
On Error Resume Next
For i = 1 To 1
ar = Split(text, " ", x)
TextBox1 = ar(0)
TextBox2 = ar(1)
TextBox3 = ar(2)
TextBox4 = ar(3)
TextBox5 = ar(4)
TextBox6 = ar(5)
Next
On Error GoTo 0
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
End Sub
Function DemKT(Chuoi As String) As Long
Trim (Chuoi)
DemKT = Len(Chuoi) - Len(Replace(Chuoi, " ", ""))
End Function
Function JoinText(Vung As Range, Optional PC As String = ", ") As String
On Error GoTo Tiep1
With Application.WorksheetFunction
JoinText = Join(.Transpose(Vung), Chr(13))
GoTo Tiep2
Tiep1:
JoinText = Join(.Transpose(.Transpose(Vung)), Chr(13))
End With
Tiep2:
JoinText = Replace(JoinText, " ", Chr(10))
JoinText = Replace(JoinText, Chr(13), " ")
JoinText = WorksheetFunction.Trim(JoinText)
JoinText = Replace(JoinText, " ", PC)
JoinText = Replace(JoinText, Chr(10), " ")
End Function
Private Sub UserForm_Click()
End Sub
Bạn sửa như thế này
Whoa:
If Err <> 0 Then MsgBox "Khong co du lieu trong Clipboard"
text = MyString '(( neu la mot [321 3213 3213 3213 3213] thi hame chay tot
' dem chuoi
' lan sau dung Funtion WorkSheetFuntion SubTitute // ham excel
For i = 1 To 1
ar = Split(text, ChrW(9))
TextBox1 = ar(0)
TextBox2 = ar(1)
TextBox3 = ar(2)
TextBox4 = ar(3)
TextBox5 = ar(4)
TextBox6 = ar(5)
Nextthanks ban nhiều nó chay đc rồi đúng như y mình bây giờ thêm code giải phóng clipboard nữa là ok
Private Sub UserForm_Initialize() ' Gia tri khi mo Form
Private Sub UserForm1_Initialize() ' Gia tri khi mo Form
Dim Sh As Worksheet, Cls As Range
Set Sh = ThisWorkbook.Worksheets(CStr(Day([I1].Value))) 'use ham CStr Day sang Sting
Dim TB As TextBox
Dim i As Integer, j As Integer, k As Integer
'---lay gia tri ngay tu I1
' dung SET de khai bao bien doi tuong//giai phong set xx= nothing
'-----------------------------MSP1
For i = 1 To 6
TB(i).text = Sh.Range("B45").Offset(0, i)
Exit For
Next i
For j = 7 To 12
TB(j).text = Sh.Range("B49").Offset(0, j)
Exit For
Next j
For k = 13 To 17
TB(k).text = Sh.Range("B49").Offset(k, 0)
Exit For
Next k
TB(18).text = Sh.Range("B49").Offset(k, 7)
TB(19).text = Sh.Range("B49").Offset(k, 10)
'
' Dung ham Offfet
'''' Erro
End SubBạn đi không đúng hướng nên thời gian nhiều mà hiệu quả ít.
ar = Split(text, " ", x)Private Sub Nutsua_Click()
Dim i As Long, currRow As Long, LastRow As Long, Arr(1 To 7)
LastRow = Worksheets("Khachhang").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
i = ListBox1.ListIndex
Arr(1) = Stt
Arr(2) = Me.cobtenKH.Value
'arr(3) = Me.gioitinh.Value
Arr(4) = Me.cobPhone.Value
Arr(5) = Me.txtADD.Text
Arr(6) = Me.cobNhom.Value
Arr(7) = Me.txtNote.Text
Sheet7.Range("A3").Offset(Stt).Resize(1, 7).Value = Arr
RefreshListbox
End SubCái MultiPage êm không thấy Font trong Properties bác ạ
