A
Bác paulsteigel ơi, em làm giống y bác rồi mà nó cứ báo lỗi, nhờ bác xem giải thích hộ em với.
View attachment luong_vec.rar
thanks bác
Option Compare Database
Function FormulaCal(InForm As String, TblName As String, KeyField As String, KeyValue As Long) As Double
'==============================================
' Tham so dau vao:
' Inform: Cong thuc dau vao
' TblName: Ten bang chua du lieu
' KeyField: Ten truong khoa chua du lieu hien thoi
' KeyValue: Gia tri cua dong hien thoi
'==============================================
' Tat nhien cach nay cu chuoi va ban can phai them reference cho DB vao DAO hoac ADODB (neu dung no thi sua lai cau
' truc truy van nhe. Va dac biet, toc do xu ly chac se rat rua.
' Nhung cung la mot cach thay the de giai quyet chuyen Query.
Dim rs As New Recordset, i As Long, theFomular As String, prcFml As String, arrFld As Variant
theFomular = InForm
' dung thu tuc de giai quyet viec xu ly vong lap se nhanh hon
prcFml = BuildFieldList(InForm)
If prcFml = "" Then GoTo Exit_Function
arrFld = Split(prcFml, ",")
' Gio thiet ke Query cho tot
' Thuc hien Querry de lay gia tri truyen tham so cho cong thuc
' Cai nay danh cho ADO, cac ban tu giai thich tai sao toi lai dung prcFml trong doan code mo csdl sau
' Neu ban muon toc do xu ly nhanh hon thi can thiet phai thiet ke lai cach xay dung query nay
rs.Open "Select " & prcFml & " from " & TblName & " where [" & KeyField & "] = " & KeyValue & ";", CurrentProject.Connection
' Cai nay danh cho DAO
'Set rs = CurrentDb.OpenRecordset("Select " & prcFml & " from " & TblName & " where [" & KeyField & "] = " & KeyValue & ";")
' Duyet qua toan bo danh sach truong de giai quyet dut diem vu truyen tham so
If rs.EOF Then GoTo Exit_Function
For i = 0 To UBound(arrFld)
' Neu cac ban muon lam cho CSDL nghiem tuc thi can dua them dau [] vao cong thuc vi rat co the
' se xay ra lam lan khi thay the, chang han truong 1 la a, truong 2 la ab thi no thay the se sai.
' vi the ban nen dung cach sau day
' Neu dung cach tiep can duoi day thi trong cong thuc da phai co dau phan cach [] nhe
' chang han [a]+[c]+[d]
' lay ten field chinh thong
tmpFldName = Mid(arrFld(i), 2, Len(arrFld(i)) - 2)
' gan vao cong thuc
theFomular = Replace(theFomular, arrFld(i), Nz(rs.Fields(tmpFldName), 0))
Next
FormulaCal = Eval(theFomular)
Exit_Function:
rs.Close
End Function
Private Function BuildFieldList(inFml As String) As String
' Minh khong dat bay loi, ban se phai tu xu ly van de nay nhe
' Ham nay de xay dung cac danh sach truong can xu ly dua tren cach dat ten truong trong dau []
Dim prcTxt As String, lsField As String, fldName As String
Dim stPos As Long, endPos As Long
prcTxt = inFml
' Khoi dong tim dau mo truong de bat dau vong lap
stPos = InStr(prcTxt, "[")
While stPos > 0
' Lay vi tri hien thi dau dong ten truong
endPos = InStr(prcTxt, "]")
' Lay ten truong
fldName = Mid(prcTxt, stPos + 1, endPos - stPos - 1)
' ghi ten truong vao mot danh sach, ta dung dau phay thi sau nay co the xay dung luon query ma khong can lam gi them
lsField = lsField & ",[" & fldName & "]"
' thu thuat de bo qua qua trinh tim dau dong va mo truong
prcTxt = Replace(prcTxt, "[" & fldName & "]", "/" & fldName & "/")
' Lay vi tri hien thi dau mo ten truong/ tai sao phai dat o day chu yeu la nham tiet kiem thoi gian
stPos = InStr(prcTxt, "[")
Wend
BuildFieldList = Mid(lsField, 2)
End Function
