Giúp Code: lấy số liệu từ Sheet Tổng hợp và Sheet có liên quan. (5 người xem)
- Thread starter Hong.Van
- Ngày gửi
Người dùng đang xem chủ đề này
Ah, code cũ đúng thế thật vì bác số sánh gữa dton và dNx và loằng ngoằng loạn xị khó đọc thật
còn CODE mới lại không dùng Mảng cho vùng kết quả nữa ah, bác dùng RANGE rồi, lại khó đọc hơn đúng là chỉ bác cò mới thuộc đường đi lối về hihii
Sao bác không dùng code cũ là được, rui căn cứ vào ký tự I , II, ...IV của cột A vùng kết quả (hoặc cột B với SÓ 1561,152,...) mà xử các cái KHO
(dĩ nhiên khi đó khuyến cáo cho người nhập dữ liệu cột A)
thế là dễ dàng lên nhiều
Upvote
0
concogia
Gội rồi mới Cạo
- Tham gia
- 17/9/09
- Bài viết
- 3,412
- Được thích
- 6,881
Híc, ban đầu định không làm, tính "ghẹo" Ba Tê thôi, làm thử tí tẹo khích Ba Tê không ngờ ......sa vào bãi cát lún luôn
Nếu hiểu đúng & còn muốn viết thì phải viết lại từ đầu bạn ạ, đúng "nhàn cư vi ......mất ngủ"
Híc 3 cái
Upvote
0
Vậy giờ dám nhìn lại chính code đã sửa từ code chính của bác không
CODE này được phát triển từ code ver1 của bac concogia (nên công thức các cột tính toán độ chính xác có gì hỏi bác Concogia nhé), cảm ơn bác Concogia,
------------
Hoàn thiện code hơn, đảm bảo
- cho phép kiểm soát lỗi: chỉ cho phép chạy macro khi đứng ở Sheet có tên T01,T02,...T12,
- báo lỗi khi không có dữ liệu, không có sheet T## trước đó, vv
- Bấm Ctrl+R để chạy chương trình
- Bấm Ctrl+Shift+R để xóa kết quả (khi muốn xem chạy lại)
------------
Code đã tinh chỉnh lại:
- nhanh hơn , vì chỉ nhặt vào dic những số liệu từ tổng hợp ứng với tháng đang tính toán mà thui
- sử dụng Array tối đa, không sủ dụng hàm , công thức hay range khác
- Viết gọn code lại chút,
---------------
cuối cùng chú ý:
Việc căn nhóm là dựa vào các ký tự chữ I II III,.... cột A của sheet kết quả --> vì thế chú ý khi nhập liệu cột A phải được chuẩn hóa là các Tài khoản (KHO) thì đánh số la mã (hoặc ký tự A B C...) còn các các mã mục nhỏ thì đánh số 1 2 3 .... như hiện tại, và đánh thứ tự liên tục (không có cell trống là tốt nhất )
Lần chỉnh sửa cuối:
Upvote
0
Hong.Van
Busy
- Tham gia
- 7/5/12
- Bài viết
- 2,328
- Được thích
- 1,765
1/Code của anh sẽ tạo ra luôn các mục cột A, B, C, D như vậy trong các tháng sau mà có thêm mã hàng mới thì fải làm sao, VD thêm Mã H004, H005 ...Em nghĩ anh chỉ cần tạo kết qủa từ cột E đến cột M, còn các cột A, B, C, D là các cột bắt buộc có dữ liệu trước khi chạy code
2/ Khi chạy code của tháng 3 (T03) thì lúc này sheet TH chưa có tháng 3, em muốn kết qủa của T03 vẫn lấy tồn cuối kỳ tháng trước sang (lấy tồn cuối kỳ của T02), vẫn tạo kết quả tại cột "ĐGBQ" (cột J) và tạo kết qủa cuối kỳ tại cột L & M
3/ Hôm qua em quên, Cột A (số thứ tự) là kết quả do 1 code khác chạy nên, nếu anh sửa code thì đừng dựa vào nó để viết code!
Em cảm ơn!
Upvote
0
Hong.Van
Busy
- Tham gia
- 7/5/12
- Bài viết
- 2,328
- Được thích
- 1,765
Hôm qua vì vội trả lời mà em quên cột A (cột số thứ tự La mã và số) của các sheet kết qủa được tạo ra là do chạy một code khác
Như vậy dữ liệu ở các sheet kết qủa tại các cột B, C, D là nhập = tay (hoặc copy các tháng trước rồi thêm vào các mã mới nếu có phát sinh thêm)
Anh có thể giúp em lại một lần nữa là sửa code lại
Em thành thật xin lỗi anh và các Thầy vì đã làm mất thời gian và công sức của mọi người.
Em cảm ơn!
Upvote
0
Dù do code khác tạo ra, nhưng vẫn theo quy luật tôi viết trên, thì vẫn không vấn đề gì
-----------
Còn muốn phân biệt KHO (khác so với các mã con) dựa vào cột B thì lấy file kèm sau,
Chú ý tại B chỉ có các tài khoản khó là 1 số (number) các khoản mục (mã) con đều là dạng chuỗi ký tự nhé (hiện luôn là ký tự vì bắt đầu bằng chữ cái: H , L...)
Mọi vấn đề khác giống như code trước đề cập bài trên với các bẫy lỗi đầy đủ
như thử bấm Ctrl+R chạy code ở sheet TH , TH00 hay bất cứ sheets nào không thuộc T01-T12 thì đều có báo lỗi và không chạy code
Lần chỉnh sửa cuối:
Upvote
0
Hong.Van
Busy
- Tham gia
- 7/5/12
- Bài viết
- 2,328
- Được thích
- 1,765
Em đã test thử một số điều kiện và thấy chạy tốt
Còn một điểm hạn chế Các Thầy & anh giúp em chỗ này
1/Trong sheet "TH" của em chưa có ghi số liệu tháng 3, Giả sử tháng 3 là tháng "ăn chơi" trong suốt tháng 3 công ty sẽ KHÔNG NHẬP VÀ XUẤT, Như vậy khi chạy code tháng 3 thì chỉ cho kết quả Tồn đầu kỳ của tháng 3. Bây giờ em muốn cho kết qủa ở cột "ĐGBQ" (cột J) (nếu điều này không fức tạp) và cho kết qủa tồn cuối kỳ (cột L và M). Vì nếu không có kết qủa này thì sang tháng 4 (T04) số dư đầu kỳ của tháng này sẽ không lấy được của cuối kỳ tháng 03
2/ Mặt khác em thấy, nếu trong 1 tháng mà TOÀN BỘ Mã con Không CÓ NHẬP VÀ XUẤT thì kết qủa giống như mục 1 nói trên (VÍ DỤ: Bên sheet TH, trong tháng 02, ta Delete toàn bộ nhập xuất của các mã có chữ L đầu)
------------------
Nhân đây em xin các Thầy & anh viết giúp em code kết quả cho cả MỘT NĂM (nghĩa là lấy toàn bộ nhập xuất của một năm) và em đặt tên cho nó là sheet T13
(Em có làm công thức trong T13)
Em xin mô tả như sau:
Về số liệu kho hàng như mã 1561, 152, 153, 155 thì vẫn giống như code lấy cho kết quả từng tháng
Còn các mã con thì em lấy ví dụ mã H001 như sau
Tồn đầu kỳ cột E & F : vẫn lấy tồn cuối kỳ của sheet T00
Cột G, H, I : trước đây em dùng hàm SUMPRODUCT() để lấy kết quả, nay em chỉ dùng hàm SUMIF()
Cột J : Không tính
Cột K: trước đây em dùng công thức K10=I10*J10, nhưng bây giờ em dùng Hàm SUMIF()
Và cột L và M tính giống như trước
Em xin cảm ơn các Thầy cô & anh chị
---------------
P/s: vì em đang muốn áp dụng code ở đề tài này để áp dụng cho một số bài thực tế khác có cấu trúc gần giống, nếu chỗ đọan code nào khó thì cho ghi cho em vài lời ghi chú giải thích
Upvote
0
Quang_Hải
Thành viên gạo cội
- Tham gia
- 21/2/09
- Bài viết
- 6,073
- Được thích
- 8,004
- Nghề nghiệp
- Làm đủ thứ
Code bên trong dễ như đám rừng vậy đó nên không có chỗ nào cần chú thích cả đâu nhé.
Sheet T13 thì có nút bấm, những sheet kia thì CTRL + R để chạy code
PS: Nhớ phản hồi xem cái đám rừng kia mần ăn gì được không nhé
Lần chỉnh sửa cuối:
Upvote
0
Hong.Van
Busy
- Tham gia
- 7/5/12
- Bài viết
- 2,328
- Được thích
- 1,765
Em đã Test với dữ liệu nhỏ thì thấy rất tốt, để em tạo dữ liệu nhiều thì xem kết qủa ra sao?
Hi, như đám rừng thiệt, nhưng quan trọng em đọc có dễ hiểu không, từ đó có thể áp dụng vào các File khác.
-----------------
Anh vodoi2x vẫn giúp em hoàn tất bài trên nha, code của anh có điểm đặc biệt là hiện các thông báo
Mặt khác em vẫn muốn học cái hay của mỗi người.
Em xin cảm ơn tất cả các Thầy & anh chị!
Upvote
0
Muốn học gì thì cứ túm co........
?cổ bác concogia nhe (hihiii) - vì code chính của bác ấy mà, tôi chỉ thêm mắm muối vào thôi và thêm chút bột ngọt nữaGiờ không căn cứ vào giá trị số hay text của cột B (sheets kết quả) nữa, mà xem mã của cột B này có thuộc 4 tài khoản trong HẰNG SỐ tkChinh = "#1561#152#153#155#"
bấm Alt+F11 Mở code sẽ thấy 2 dòng này ngay module
PHP:
Const tkChinh = "#1561#152#153#155#" 'hang so cho phep Thay doi tai khoan CHINH
Const stRow = 9 'hang so dong bat dau cho phan du lieu cua tat cac sheet du lieu, ket qua-------------
Code vẫn thế chỉ sửa chút cho phép chạy ở sheet T13 - nên từ T01 ->T13 vẫn cứ bấm Ctrl+R để chạy và Ctrl+Shift+R để xóa
Mọi báo lỗi vẫn thế
Upvote
0
Hong.Van
Busy
- Tham gia
- 7/5/12
- Bài viết
- 2,328
- Được thích
- 1,765
Em đã kiểm tra và code còn một lỗi như sau:
Tại Sheet TH, anh xóa cột B ( cột Ngày)
Tại Sheet T01, anh chạy code. Kết quả là nó vẫn cho kết qủa tại cell G10 và H10
Em cảm ơn
-----------
Mấy ngày nghiên cứu code của các Thầy & các anh, em thấy em còn mông lung quá! Không biết có thể áp dụng cho các bài khác của em được kg nữa!
Upvote
0
Hong.Van
Busy
- Tham gia
- 7/5/12
- Bài viết
- 2,328
- Được thích
- 1,765
Em chào Thầy cô & anh chị!Muốn học gì thì cứ túm co........
Giờ không căn cứ vào giá trị số hay text của cột B (sheets kết quả) nữa, mà xem mã của cột B này có thuộc 4 tài khoản trong HẰNG SỐ tkChinh = "#1561#152#153#155#"
bấm Alt+F11 Mở code sẽ thấy 2 dòng này ngay module
Bạn có thể bổ sung TÀI KHOẢN CHÍNH vào đây khi cần tăng thêm KHO (dĩ nhiên cho dư cũng được, nhưng nhớ là không thiếu và trùng các mã con hàng hóa )PHP:Const tkChinh = "#1561#152#153#155#" 'hang so cho phep Thay doi tai khoan CHINH Const stRow = 9 'hang so dong bat dau cho phan du lieu cua tat cac sheet du lieu, ket qua
-------------
Code vẫn thế chỉ sửa chút cho phép chạy ở sheet T13 - nên từ T01 ->T13 vẫn cứ bấm Ctrl+R để chạy và Ctrl+Shift+R để xóa
Mọi báo lỗi vẫn thế
Em có áp dụng code bài #34 vào thực tế như sau
Mã:
Option Explicit
Const tkChinh = "#1561#152#153#155#" 'hang so cho phep Thay doi tai khoan CHINH
Const stRow = 9 'hang so dong bat dau cho phan du lieu cua tat cac sheet du lieu, ket qua
'bam phim tat Ctrl+R
'by vodoi2x vodoi2x vodoi2x vodoi2x vodoi2x
'main code from Concogia GPE
Sub TH()
Dim CoT13 As Boolean, dTon As Object, dNx As Object, wSp As Worksheet, TongHop, ArrNx, aTon, kQ, ArrKq
Dim i As Long, k As Long, kK As Long, MM As Long, j As Long, n As Long, nk As Long, tmP As String, WsPre, sT As String
'Kiem soat loi va nhap du lieu
sT = Trim(UCase(ActiveSheet.Name))
If Not sT Like "T##" Then MsgBox "Phai chay macro nay tai sheet " & Chr(13) & " T##: T01,T02,...,T12, T13", , "sub TH": Exit Sub
MM = Val(Right(sT, 2))
If MM < 1 Or MM > 13 Then MsgBox "Phai chay macro nay tai sheet " & Chr(13) & " T##: T01,T02,...,T12 T13", , "sub TH": Exit Sub
CoT13 = (MM = 13): k = IIf(CoT13, 0, MM - 1)
On Error Resume Next
Set wSp = Sheets("T" & Format(k, "00"))
On Error GoTo 0
If wSp Is Nothing Then MsgBox "Khong ton tai sheet ky truoc " & "T" & Format(k, "00"), , "sub TH": Exit Sub
With wSp
k = .[B65536].End(xlUp).Row
If k < stRow Then MsgBox "Khong ton tai du lieu TON o sheet " & wSp.Name, , "sub TH": Exit Sub
aTon = .Range("B" & stRow & ":B" & k).Resize(, 12).Value
End With
With Sheets("TH")
k = .[C65536].End(xlUp).Row
If k < stRow Then MsgBox "Khong ton tai du lieu o file tong hop", , "sub TH": Exit Sub
TongHop = .Range("C" & stRow & ":C" & k).Resize(, 15)
End With
ReDim ArrNx(1 To UBound(TongHop), 1 To 4)
k = [B65536].End(xlUp).Row
If k < stRow Then MsgBox "Khong ton tai du lieu o Sheet hien tai", , "sub TH": Exit Sub
kQ = Range("B" & stRow & ":B" & k).Value
nk = UBound(kQ) + 1: ReDim ArrKq(1 To nk, 1 To 9)
'Tinh toan
Set dNx = CreateObject("scripting.dictionary")
n = IIf(CoT13, 4, 3)
For i = 1 To UBound(TongHop)
If CoT13 Or UCase(Trim(TongHop(i, 1))) = sT Then
tmP = TongHop(i, 9)
If Not dNx.exists(tmP) Then
k = k + 1: dNx.Add tmP, k: kK = k
Else: kK = dNx.Item(tmP): End If
For j = 1 To n
[COLOR=#ff0000][B]ArrNx(kK, j) = ArrNx(kK, j) + TongHop(i, 11 + j)[/B][/COLOR]
Next j
End If
Next i
Set dTon = CreateObject("scripting.dictionary")
With wSp
For i = 1 To UBound(aTon)
If Not dTon.exists(aTon(i, 1)) Then dTon.Add aTon(i, 1), Array(aTon(i, 11), aTon(i, 12))
Next i
End With
For i = 1 To nk - 1 'nk-1=Ubound(kq)
tmP = Trim(kQ(i, 1))
If tmP <> "" Then
If InStr(1, tkChinh, "#" & tmP & "#", vbTextCompare) Then
k = i
Else
If dTon.exists(tmP) Then
ArrKq(i, 1) = dTon.Item(tmP)(0): ArrKq(i, 2) = dTon.Item(tmP)(1)
ArrKq(k, 1) = ArrKq(k, 1) + ArrKq(i, 1): ArrKq(k, 2) = ArrKq(k, 2) + ArrKq(i, 2)
ArrKq(nk, 1) = ArrKq(nk, 1) + ArrKq(i, 1): ArrKq(nk, 2) = ArrKq(nk, 2) + ArrKq(i, 2)
End If
If dNx.exists(tmP) Then
For j = 3 To 5
ArrKq(i, j) = ArrNx(dNx.Item(tmP), j - 2)
Next j
If CoT13 Then ArrKq(i, 7) = ArrNx(dNx.Item(tmP), 4)
End If
If Not CoT13 Then
If ArrKq(i, 1) + ArrKq(i, 3) <> 0 Then ArrKq(i, 6) = (ArrKq(i, 2) + ArrKq(i, 4)) / (ArrKq(i, 1) + ArrKq(i, 3))
If ArrKq(i, 5) <> 0 Then ArrKq(i, 7) = ArrKq(i, 5) * ArrKq(i, 6)
End If
If ArrKq(i, 1) <> 0 Or ArrKq(i, 3) <> 0 Or ArrKq(i, 5) <> 0 Then ArrKq(i, 8) = ArrKq(i, 1) + ArrKq(i, 3) - ArrKq(i, 5)
If ArrKq(i, 2) <> 0 Or ArrKq(i, 4) <> 0 Or ArrKq(i, 7) <> 0 Then ArrKq(i, 9) = ArrKq(i, 2) + ArrKq(i, 4) - ArrKq(i, 7)
For j = 3 To 9
If j <> 6 And ArrKq(i, j) <> 0 Then ArrKq(k, j) = ArrKq(k, j) + ArrKq(i, j): ArrKq(nk, j) = ArrKq(nk, j) + ArrKq(i, j)
Next j
End If
End If
Next i
'Gan ket qua & ket thuc
Range("E" & stRow).Resize(nk, 9) = ArrKq
Set dTon = Nothing: Set dNx = Nothing
End Sub"Run - time error 9
Subcript out of range"
(dòng chữ màu đỏ)
Em đã tìm nhưng vẫn chưa được, Nhờ Thầy cô & anh chị giúp sửa code.
Em cảm ơn!
Upvote
0
