Tính tỉ lệ phần trăm theo điều kiện (1 người xem)

  • Thread starter Thread starter kaka01
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
K

kaka01

Thành viên chính thức
Tham gia
12/2/16
Bài viết
55
Được thích
11
Xin chào các anh chị GPE
Em có file như dữ liệu đính kèm, em muốn viết code VBA
để lọc ra danh sách duy nhất từ sheet data sang sheet Kq
sau đó tinh % theo ngày của từng mã code đó
(Nếu dùng sumifs thì có thề làm được nhưng em muốn sử dụng code để xử lý khi dữ liệu lớn
em đã thử với "Scriting.Dictionary" nhưng tính không chính xác) nhờ các ạnh chị hướng dẫn giúp
Em xin cảm ơn!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
hpkhuong đã viết:
Mã: 
Public Sub GPE()
Dim cn As Object, Str
Set cn = CreateObject("ADODB.Connection")
Str = "Select f2,f3,sum(f5)/sum(f4) from [Data$A2:E] where f1 is not null group by f2,f3"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
Sheets("Kq").Range("A1").CurrentRegion.Offset(1).ClearContents
Sheets("Kq").Range("B2").CopyFromRecordset cn.Execute(Str)
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn hpKhuong!
Cho em hỏi đây có phải là mã code của SQL không ạ? vì em mới học VBA thấy dòng code hơi lạ!
 
Upvote 0
VetMini đã viết:
"đây" của bạn là chỗ nào? "dòng code hơi lạ" là dòng nào?
Nhấp chuột vào đây để mở rộng...
Xin lỗi anh VetMini! vì không trình bày rõ. ý của em là toàn bộ đoạn code mà anh hpkhuong viết giúp em bên trên ạ
vì chưa biết nhiều về code VBA em mới phỏng đoán như vậy, nếu phần này thuộc VBA thì anh chỉ giúp em cách tiếp cận
các lệnh này ở phần nào hay nguồn tài liệu nào(có thể đã có bài trên diễn đàn)để em tìm hiểu thêm!
Cảm ơn anh!
 
Upvote 0
Code trên là code VBA.
Code này dùng ADO (Object) để truy vấn CSDL (ở đây là 1 sheet trong file excel)
Trong đó chỉ có cái chuỗi ở dòng thứ tư (Select ...) là chuỗi lệnh SQL dùng để ADO truy vấn.

Vào góc CSDL (ngay bên dưới góc lập trình này) mà tìm hiểu mấy bài về ADO, DAO.
 
Upvote 0
VetMini đã viết:
Code trên là code VBA.
Code này dùng ADO (Object) để truy vấn CSDL (ở đây là 1 sheet trong file excel)
Trong đó chỉ có cái chuỗi ở dòng thứ tư (Select ...) là chuỗi lệnh SQL dùng để ADO truy vấn.

Vào góc CSDL (ngay bên dưới góc lập trình này) mà tìm hiểu mấy bài về ADO, DAO.
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh VetMini!
em tìm hiểu thêm về phần ADO , DAO theo hướng dẫn trên của anh
Với trường hợp đề bài trên của em có thể dùng code về Arr hay Scriting.Dictionary không anh?
Nếu được xin nhờ anh viết code giúp em ạ!
Cảm ơn anh!
 
Upvote 0
Gửi các anh chị GPE!
Anh chị thử giúp em đề bài trên dùng Arr hay Dic. được không ạ?
Có thể dùng SQl như anh hpkhuong giúp trên là tối ưu nhất
nhưng trường hợp này liệu có giải pháp để dùng với Arr hay Dic không?
Nếu được các anh chị viết code giúp em nhé!
Chân thành cảm ơn!
 
Upvote 0
hpkhuong đã viết:
Tại sao phải người ta thử viết cho bạn, mà bạn không phải là người thử??? bạn không thử thì sao bạn biết??? thử là thử thế nào???
Mã: 
Public Sub GPE_()
Dim dArr, kArr, I As Long, J As Long, K As Long, Dic As Object, Tem As String, R As Long
dArr = Sheets("Data").Range("A1").CurrentRegion.Value
ReDim kArr(1 To UBound(dArr), 1 To 4)
ReDim tArr(1 To UBound(dArr), 1 To 2)
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False

    For I = 2 To UBound(dArr)
        Tem = dArr(I, 2) & "#" & dArr(I, 3)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            kArr(K, 1) = K
            kArr(K, 2) = dArr(I, 2)
            kArr(K, 3) = dArr(I, 3)
            tArr(K, 1) = dArr(I, 4)
            tArr(K, 2) = dArr(I, 5)
            If tArr(K, 1) > 0 Then kArr(K, 4) = tArr(K, 2) / tArr(K, 1)
        Else
            R = Dic.Item(Tem)
            tArr(R, 1) = tArr(R, 1) + dArr(I, 4)
            tArr(R, 2) = tArr(R, 2) + dArr(I, 5)
            If tArr(R, 1) > 0 Then kArr(R, 4) = tArr(R, 2) / tArr(R, 1)
        End If
    Next
If K Then
    Sheet2.Range("A2").Resize(K, 4).Value = kArr
    Sheet2.Range("B2").Resize(K, 3).Sort Range("B2"), xlAscending, Range("C2"), , xlAscending
End If
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh hpkhuong!
Xin lỗi anh khi gửi bài em chưa gắn code đã thử nhưng kết quả chưa chính xác
do em mới học lên chưa hiểu hết cách ứng dụng của phần Dic này.
lần sau em gửi cả code của em lên có gì nhờ anh sửa giúp ạ!

Trân trọng cảm ơn!
 
Upvote 0
kaka01 đã viết:
Gửi các anh chị GPE!
Anh chị thử giúp em đề bài trên dùng Arr hay Dic. được không ạ?
Có thể dùng SQl như anh hpkhuong giúp trên là tối ưu nhất
nhưng trường hợp này liệu có giải pháp để dùng với Arr hay Dic không?
Nếu được các anh chị viết code giúp em nhé!
Chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Bài này nếu theo thuật toán căn bản thì sort và đọc mảng, tính tổng.
ADO và Dic này nọ chỉ là sì tin riêng của dân trên GPE thôi.
 
Upvote 0
kaka01 đã viết:
Xin chào các anh chị GPE
Em có file như dữ liệu đính kèm, em muốn viết code VBA
để lọc ra danh sách duy nhất từ sheet data sang sheet Kq
sau đó tinh % theo ngày của từng mã code đó
(Nếu dùng sumifs thì có thề làm được nhưng em muốn sử dụng code để xử lý khi dữ liệu lớn
em đã thử với "Scriting.Dictionary" nhưng tính không chính xác) nhờ các ạnh chị hướng dẫn giúp
Em xin cảm ơn!
Nhấp chuột vào đây để mở rộng...
Bạn kiểm tra file đính kèm xem có đúng không
 

File đính kèm

Upvote 0
hpkhuong đã viết:
Tại sao phải người ta thử viết cho bạn, mà bạn không phải là người thử??? bạn không thử thì sao bạn biết??? thử là thử thế nào???
Mã: 
Public Sub GPE_()
Dim dArr, kArr, I As Long, J As Long, K As Long, Dic As Object, Tem As String, R As Long
dArr = Sheets("Data").Range("A1").CurrentRegion.Value
ReDim kArr(1 To UBound(dArr), 1 To 4)
ReDim tArr(1 To UBound(dArr), 1 To 2)
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False

    For I = 2 To UBound(dArr)
        Tem = dArr(I, 2) & "#" & dArr(I, 3)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            kArr(K, 1) = K
            kArr(K, 2) = dArr(I, 2)
            kArr(K, 3) = dArr(I, 3)
            tArr(K, 1) = dArr(I, 4)
            tArr(K, 2) = dArr(I, 5)
            If tArr(K, 1) > 0 Then kArr(K, 4) = tArr(K, 2) / tArr(K, 1)
        Else
            R = Dic.Item(Tem)
            tArr(R, 1) = tArr(R, 1) + dArr(I, 4)
            tArr(R, 2) = tArr(R, 2) + dArr(I, 5)
            If tArr(R, 1) > 0 Then kArr(R, 4) = tArr(R, 2) / tArr(R, 1)
        End If
    Next
If K Then
    Sheet2.Range("A2").Resize(K, 4).Value = kArr
    Sheet2.Range("B2").Resize(K, 3).Sort Range("B2"), xlAscending, Range("C2"), , xlAscending
End If
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Gửi anh hkphuong!
Cảm ơn anh về code hôm trước anh viết cho em đã chạy tốt
hiện tại em phát sinh thêm vấn đề là vẫn dữ liệu đó nhưng lọc sang
sheet Baocao với số Code duy nhất theo cột, số Date duy nhất theo hàng
sau đó tính % = FF/Quantity theo cấu trúc lọc được
Hiện tại em làm thủ công bước lọc duy nhất số Code và Date
sau đó tính % sửa code dựa vào code hôm trước anh giúp nhưng
không ra kết quả chính xác (em gửi lại file dữ liệu)
Nhờ anh viết code giúp em.
Chân thành cảm ơn
 

File đính kèm

Upvote 0
hpkhuong đã viết:
Mã: 
Public Sub GPE_2()
Dim dArr, kArr, I As Long, J As Long, K As Long, Dic As Object, Tem As String, R As Long
Dim N As Long, N1 As Long, TemD As Date
dArr = Sheets("Data").Range("A1").CurrentRegion.Value
ReDim kArr(1 To UBound(dArr), 1 To 500)
ReDim tArr(1 To UBound(dArr), 1 To 1000)
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
K = 1: kArr(1, 1) = "No.": kArr(1, 2) = "Code"
For I = 2 To UBound(dArr)
    Tem = dArr(I, 2): TemD = dArr(I, 3)
    If Not Dic.Exists(TemD) Then
        N = N + 1
        Dic.Add TemD, N
        kArr(1, N + 2) = TemD
    End If
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        kArr(K, 1) = K - 1
        kArr(K, 2) = Tem
    End If
        R = Dic.Item(Tem): N1 = Dic.Item(TemD)
        tArr(R, N1) = tArr(R, N1) + dArr(I, 4)
        tArr(R, N1 + 500) = tArr(R, N1 + 500) + dArr(I, 5)
        If tArr(R, N1) > 0 Then kArr(R, N1 + 2) = tArr(R, N1 + 500) / tArr(R, N1)
Next
If K Then
    Sheet3.Range("A2").Resize(K, N + 2).Value = kArr
End If
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Chân thành cảm ơn anh hpkhuong!
code chạy rất chính xác theo đề bài
em nghiên cứu thêm có đoạn nào em chưa hiểu nhờ anh chỉ giúp ạ
Cảm ơn anh nhiều!
 
Upvote 0
hpkhuong đã viết:
Mã: 
Public Sub GPE_2()
Dim dArr, kArr, I As Long, J As Long, K As Long, Dic As Object, Tem As String, R As Long
Dim N As Long, N1 As Long, TemD As Date
dArr = Sheets("Data").Range("A1").CurrentRegion.Value
ReDim kArr(1 To UBound(dArr), 1 To 500)
ReDim tArr(1 To UBound(dArr), 1 To 1000)
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
K = 1: kArr(1, 1) = "No.": kArr(1, 2) = "Code"
For I = 2 To UBound(dArr)
    Tem = dArr(I, 2): TemD = dArr(I, 3)
    If Not Dic.Exists(TemD) Then
        N = N + 1
        Dic.Add TemD, N
        kArr(1, N + 2) = TemD
    End If
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        kArr(K, 1) = K - 1
        kArr(K, 2) = Tem
    End If
        R = Dic.Item(Tem): N1 = Dic.Item(TemD)
        tArr(R, N1) = tArr(R, N1) + dArr(I, 4)
        tArr(R, N1 + 500) = tArr(R, N1 + 500) + dArr(I, 5)
        If tArr(R, N1) > 0 Then kArr(R, N1 + 2) = tArr(R, N1 + 500) / tArr(R, N1)
Next
If K Then
    Sheet3.Range("A2").Resize(K, N + 2).Value = kArr
End If
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Chào anh hpkhuong!
Anh cho em hỏi một chút về code hôm vừa rùi anh viết giúp em
tại dòng code: "tArr(R, N1 + 500) = tArr(R, N1 + 500) + dArr(I, 5)"
số 500 ở đây là thông số gì vậy anh? em thử bỏ số này đi hoặc thay
bằng số khác thì code vẫn chạy nhưng toàn bộ kết quả chuyển về 0
em chưa hiểu ý nghĩa của thông số này, anh có thể giải thích giúp em được không ạ?
Chân thành cảm ơn anh!
 
Upvote 0
hpkhuong đã viết:
500 là con số bình thường chứ thông số gì.
Tôi lợi dụng 1 mảng để gán kết quả của 2 trường. (Dự bị cho khoản cột dữ liệu tối đa là 500 cột ngày.)
Sau đó chia lại để lấy tỷ lệ thôi. Chứ có gì mà phải giải thích.
Bạn muốn biết thì tự nghiên cứu lấy...
Nhấp chuột vào đây để mở rộng...
Vâng xin chân thành cảm ơn anh!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
Quản Lý Công Văn đi Và đến (1 người xem)
9 10 11
Trả lời
214
Đọc
158K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ
Trả lời
3
Đọc
51
VetMini
V
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước. (2 người xem)
Trả lời
2
Đọc
42
hanhnguyen12022021
H
S
RemoveDuplicates Adodb VBA (2 người xem)
Trả lời
0
Đọc
48
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT (1 người xem)
Trả lời
0
Đọc
81
giaoluu1231
G
N
Không chạy được file VBA (2 người xem)
Trả lời
1
Đọc
49
yaaasoo01
Y
sangvanng92
  • Question Question
Phân quyền user truy cập (1 người xem)
Trả lời
9
Đọc
155
Hoàng Tuấn 868
H
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
7
Đọc
136
DinhManh1307
DinhManh1307
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
6
Đọc
294
tranhungdao12a3
T
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
Trả lời
0
Đọc
678
GPE-Trợ Lý
GPE-Trợ Lý
befaint
Chia sẻ tâm tư, xả nỗi lòng (1 người xem)
    • Thích
36 37 38
Trả lời
759
Đọc
49K
befaint
befaint
H
Quên mật khẩu khóa protect
Trả lời
18
Đọc
258
HeSanbi
HeSanbi
T
  • Question Question
Tìm này không xuất hiện trong khoảng thời gian
Trả lời
7
Đọc
105
tuan16
T
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
5
Đọc
186
befaint
befaint
nghiahandsome1995
Xin mã code autofit
Trả lời
4
Đọc
143
yaaasoo01
Y
tuankieu28
Hỗ trợ sửa hàm tìm thông tin
Trả lời
1
Đọc
44
thuytrangbp28
T
N
Cho em xin hỏi về hàm Workday về ngày làm bù ạ (1 người xem)
Trả lời
3
Đọc
93
hoangtuaotrang_hp_vn
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
324
Đọc
24K
vanthuan986
V
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
10
Đọc
1K
trung_bhxh
T
D
Chuyển đổi font chữ VNI-Time.
    • Cười
Trả lời
6
Đọc
495
vanle33
vanle33
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom