Sao cần phải tạo nhiều form thế bạn? Tôi nghĩ bạn nên tạo 1 form duy nhất rồi điền dữ liệu theo ý muốn vào là được.
Cảm ơn anh đã quan tâm. File phieu_thu là em xuất ra từ hệ thống, giờ em muốn lấy một số thông tin sang file tong hop căn cứ vào họ tên học sinh ạ
Xem lại phần mềm có xuất dữ liệu dạng bảng liệt kê không?
Lấy ở cột F (N) hay cột G (O) hay lấy ở cả 02 cột F(N) và G(O)? Sao mình không cho vài kết quả minh họa???????????
Hiện tại hệ thống chưa hỗ trợ xuất dữ liệu ở dạng liệt kê anh ạ. Còn giá trị cần lấy từ file phiếu thu sang file tong hop là số tiền tại cột F, G hay N, O dựa trên tên học sinh và các tiêu chí. Cứ mỗi lớp có một phiếu thu như vậy. Cảm ơn anh đã quan tâm
Trong một lớp, họ và tên của các cháu trùng nhau (giống hệt nhau ấy) thì xử lý như nào?
Với dữ liệu như thế này thì đừng tốn công vô ích, sẽ có nhiều vấn đề khi sử dụng nhé.
Không rỏ file tong hop nhập liệu kiểu gì nên xử lý từng dòng cho yên tâm, 1 lớp có tên trùng thì chỉnh tay
Cảm ơn anh
Chỉnh lại code, xử lý trùng tên trong 1 lớp thì ghi nhận theo thứ tự trước sau, nếu không đúng thứ tự thì chỉnh tay
Sub TongHop()
Dim Path As String, FileName As String
Dim Wb As Workbook
Dim sArr(), dArr(), Res(), CapNhat() As Boolean
Dim ten As String, lop As String, lopCN As String, key As String, tmp As String
Dim i As Long, j As Byte, n As Byte
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = ThisWorkbook.Path
FileName = GetFile(ThisWorkbook.Path)
Set Wb = Workbooks.Open(FileName)
i = Wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If i > 10 Then sArr = Wb.ActiveSheet.Range("A1:O" & i).Value
Wb.Close False
Set Wb = Nothing
If i < 11 Then MsgBox ("File khong co du lieu"): GoTo Thoat
With Sheets("Sheet1")
dArr = .Range("C2:D" & .Range("C" & Rows.Count).End(xlUp).Row).Value
End With
ReDim Res(1 To 1, 1 To 3)
ReDim CapNhat(1 To UBound(dArr))
With CreateObject("Scripting.dictionary")
For i = 1 To UBound(dArr)
ten = UCase(Application.Trim(dArr(i, 1)))
lop = UCase(Application.Trim(dArr(i, 2)))
key = ten & "#" & lop
If Not .exists(key) Then
.Add key, i
Else
For j = 1 To 10
tmp = key & "#" & j
If Not .exists(tmp) Then .Add tmp, i: Exit For
Next j
End If
Next i
For i = 5 To UBound(sArr) Step 25
For n = 1 To 9 Step 8
ten = UCase(Application.Trim(sArr(i, n)))
lop = UCase(Application.Trim(sArr(i + 1, n)))
If Len(ten) > 11 And Len(lop) > 5 Then
key = Mid(ten, 12, Len(ten)) & "#" & Mid(lop, 6, Len(lop))
ik = 0
If .exists(key) Then
ik = .Item(key)
.Remove (key)
Else
For j = 1 To 10
tmp = key & "#" & j
If .exists(tmp) Then
ik = .Item(tmp)
.Remove (tmp)
Exit For
End If
Next j
End If
If ik Then
Res(1, 1) = sArr(i + 6, n + 6)
Res(1, 2) = sArr(i + 7, n + 6)
Res(1, 3) = sArr(i + 8, n + 6)
Range("E1:G1").Offset(ik) = Res
If lopCN = Empty Then lopCN = Mid(lop, 6, Len(lop))
CapNhat(ik) = True
End If
End If
Next n
Next i
End With
For i = 1 To UBound(dArr)
If lopCN = UCase(Application.Trim(dArr(i, 2))) And CapNhat(i) = False Then Range("E1:G1").Offset(i).ClearContents
Next i
Thoat:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubTrong file trước khi chạy code có gì?
Mã học sinh lấy ở đâu?
Do file phiếu thu xuất trên hệ thống không có phần mã học sinh nên chỉ dựa vào tên và lớp của học sinh thôi ạ. Trường hợp trùng tên trong cùng lớp thì tự chỉnh tay.
Theo tôi thì cái phần mềm này còn thiếu nhiều nội dung cần góp ý để bổ sung thêm, như sau:
Code đơn giản hơn
Sub TongHop()
Dim Path As String, FileName As String
Dim Wb As Workbook
Dim sArr(), Res()
Dim ten As String, lop As String
Dim i As Long, ik As Long, j As Byte, n As Byte
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = ThisWorkbook.Path
FileName = GetFile(ThisWorkbook.Path)
If FileName = Empty Then MsgBox ("Chua Chon File"): GoTo Thoat
Set Wb = Workbooks.Open(FileName)
i = Wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If i > 10 Then sArr = Wb.ActiveSheet.Range("A1:O" & i).Value
Wb.Close False
Set Wb = Nothing
If i < 11 Then MsgBox ("File khong co du lieu"): GoTo Thoat
ReDim Res(1 To (UBound(sArr) * 6) \ 25 + 2, 1 To 6)
For i = 5 To UBound(sArr) Step 25
For j = 1 To 9 Step 8
ten = sArr(i, j)
lop = sArr(i + 1, j)
If Len(ten) > 11 And Len(lop) > 5 Then
k = k + 1
ik = (k - 1) * 3 + 1
Res(ik, 1) = k
Res(ik, 3) = Mid(ten, 12, Len(ten))
Res(ik, 4) = Mid(lop, 6, Len(lop))
For n = 0 To 2
Res(ik + n, 5) = sArr(i + n + 6, j + 1)
Res(ik + n, 6) = sArr(i + n + 6, j + 6)
Next n
End If
Next j
Next i
With Sheets("Sheet1")
i = .Range("E" & Rows.Count).End(xlUp).Row
If i > 1 Then .Range("A2:F" & i).Clear
If ik Then
.Range("A2:F2").Resize(ik + 2) = Res
.Range("A2:F2").Resize(ik + 2).Borders.LineStyle = 1
End If
End With
Thoat:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubCảm ơn anh Hiếu đã quan tâm giúp đỡ. Với code này rất đúng ý muốn của em. Tuy nhiên, khi chạy với file “phieu_thu” ở trên thì ra kết quả đúng, nhưng em thử với file “phieu_thu1” (gửi kèm theo) thì không còn chính xác nữa ạ. Nhờ anh xem giúp em với ạ.
Cái này là do lỗi phần mềm xuất ra không có quy luật nhất định (mỗi phiếu lúc thì 25 dòng, lúc thì 27 dòng).
Cảm ơn bạn đã quan tâm. Vấn đề là mình không muốn chỉnh sửa file “phieu_thu” ạ, vì mỗi tháng ví trí sẽ là khác nhau do thêm/bớt các khoản thu. Có cách nào để tự động xác định được vùng cần lấy mà không phải sửa file “phieu_thu”.
