Tính toán doanh số bán hàng

Liên hệ QC
Y

Yeuvoyeucon

Thành viên hoạt động
Tham gia
30/10/09
Bài viết
143
Được thích
23
Kính gửi anh chị,
Em muốn đưa ra danh sách nhân viên, thông tin và tính toán theo các tiêu thức mà em đã làm bằng hàm tại vùng màu xanh. Thực hiện bằng code sẽ như thế nào mong các anh chị giúp đỡ ạ.
 

File đính kèm

  • Tinh toan doanh so ban hang.xlsm
    14.9 KB · Đọc: 26
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Yeuvoyeucon đã viết:
Kính gửi anh chị,
Em muốn đưa ra danh sách nhân viên, thông tin và tính toán theo các tiêu thức mà em đã làm bằng hàm tại vùng màu xanh. Thực hiện bằng code sẽ như thế nào mong các anh chị giúp đỡ ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thử code sau:
Mã: 
Option Explicit

Public Function danh_gia(ByVal thangdiem, ByVal kq As Double) As String
    Dim i As Long
    For i = LBound(thangdiem, 1) To UBound(thangdiem, 1)
       If (kq >= thangdiem(i, 1)) Then
            danh_gia = thangdiem(i, 2)
       End If
    Next i
End Function

Sub tinh_doanhsobanhang()
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Dim data As Variant, res As Variant, ass As Variant
    Dim sCode As String
    Dim sum_doanhso As Double
    Dim i As Long, k As Long, r As Long
    
    With ThisWorkbook.Worksheets("Doanh_so")
        r = .Cells(.Rows.Count, "B").End(xlUp).Row
        If r < 2 Then Exit Sub
        ass = .Range("S1:T4").Value
        
        data = .Range("B2:E" & r).Value
        ReDim res(1 To UBound(data, 1), 1 To 8)
        sum_doanhso = WorksheetFunction.Sum(.Range("D2:D" & r))
        For i = LBound(data, 1) To UBound(data, 1)
            sCode = data(i, 1)
            If Not dic.Exists(sCode) Then
                k = k + 1
                dic.Add sCode, k
                res(k, 1) = sCode
                res(k, 2) = data(i, 2)
                res(k, 3) = data(i, 4)
                res(k, 4) = data(i, 4)
                res(k, 5) = 1
                res(k, 6) = data(i, 3)
                If (sum_doanhso > 0) Then
                    res(k, 7) = res(k, 6) / sum_doanhso
                End If
                res(k, 8) = danh_gia(ass, res(k, 6))
            Else
                r = dic.Item(sCode)
                res(r, 5) = res(r, 5) + 1
                If data(i, 4) < res(r, 3) Then res(r, 3) = data(i, 4)
                If data(i, 4) > res(r, 4) Then res(r, 4) = data(i, 4)
                res(r, 6) = res(r, 6) + data(i, 3)
                If (sum_doanhso > 0) Then
                    res(r, 7) = res(r, 6) / sum_doanhso
                End If
                res(r, 8) = danh_gia(ass, res(r, 6))
            End If
        Next i
        
        '// Chinh lai "I13" cho phu hop voi vung du lieu ban muon
        .Range("I13").Resize(10000, 8).ClearContents
        If k > 0 Then .Range("I13").Resize(k, 8).Value = res
        
    End With
    
End Sub
 
Upvote 0
Yeuvoyeucon đã viết:
Kính gửi anh chị,
Em muốn đưa ra danh sách nhân viên, thông tin và tính toán theo các tiêu thức mà em đã làm bằng hàm tại vùng màu xanh. Thực hiện bằng code sẽ như thế nào mong các anh chị giúp đỡ ạ.
Nhấp chuột vào đây để mở rộng...
Trong khi chờ các anh chị em khác cung cấp các giải pháp cao siêu Pivot table, ADO ..... Bạn thử code này xem sao. Hy vọng đáp ứng đúng yêu cầu đề bài
Hãy nhấn nút RUN và xem và kiểm tra kết quả Tại vùng H15: P...
Code củ chuối của tinh thần nông dân chống dịch thôi, nhưng cho kết quả đúng.
Chúc vui, khỏe và an toàn trong đại dịch!
 

File đính kèm

  • Tinh toan doanh so ban hang (của YeuVoYeuCon).xlsm
    24.7 KB · Đọc: 14
Upvote 0
Hoàng Nhật Phương đã viết:
Bạn thử code sau:
Mã: 
Option Explicit

Public Function danh_gia(ByVal thangdiem, ByVal kq As Double) As String
    Dim i As Long
    For i = LBound(thangdiem, 1) To UBound(thangdiem, 1)
       If (kq >= thangdiem(i, 1)) Then
            danh_gia = thangdiem(i, 2)
       End If
    Next i
End Function

Sub tinh_doanhsobanhang()
   
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Dim data As Variant, res As Variant, ass As Variant
    Dim sCode As String
    Dim sum_doanhso As Double
    Dim i As Long, k As Long, r As Long
   
    With ThisWorkbook.Worksheets("Doanh_so")
        r = .Cells(.Rows.Count, "B").End(xlUp).Row
        If r < 2 Then Exit Sub
        ass = .Range("S1:T4").Value
       
        data = .Range("B2:E" & r).Value
        ReDim res(1 To UBound(data, 1), 1 To 8)
        sum_doanhso = WorksheetFunction.Sum(.Range("D2:D" & r))
        For i = LBound(data, 1) To UBound(data, 1)
            sCode = data(i, 1)
            If Not dic.Exists(sCode) Then
                k = k + 1
                dic.Add sCode, k
                res(k, 1) = sCode
                res(k, 2) = data(i, 2)
                res(k, 3) = data(i, 4)
                res(k, 4) = data(i, 4)
                res(k, 5) = 1
                res(k, 6) = data(i, 3)
                If (sum_doanhso > 0) Then
                    res(k, 7) = res(k, 6) / sum_doanhso
                End If
                res(k, 8) = danh_gia(ass, res(k, 6))
            Else
                r = dic.Item(sCode)
                res(r, 5) = res(r, 5) + 1
                If data(i, 4) < res(r, 3) Then res(r, 3) = data(i, 4)
                If data(i, 4) > res(r, 4) Then res(r, 4) = data(i, 4)
                res(r, 6) = res(r, 6) + data(i, 3)
                If (sum_doanhso > 0) Then
                    res(r, 7) = res(r, 6) / sum_doanhso
                End If
                res(r, 8) = danh_gia(ass, res(r, 6))
            End If
        Next i
       
        '// Chinh lai "I13" cho phu hop voi vung du lieu ban muon
        .Range("I13").Resize(10000, 8).ClearContents
        If k > 0 Then .Range("I13").Resize(k, 8).Value = res
       
    End With
   
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn OT đã giúp đỡ nhé, chúc bình an !
Bài đã được tự động gộp:

HUONGHCKT đã viết:
Trong khi chờ các anh chị em khác cung cấp các giải pháp cao siêu Pivot table, ADO ..... Bạn thử code này xem sao. Hy vọng đáp ứng đúng yêu cầu đề bài
Hãy nhấn nút RUN và xem và kiểm tra kết quả Tại vùng H15: P...
Code củ chuối của tinh thần nông dân chống dịch thôi, nhưng cho kết quả đúng.
Chúc vui, khỏe và an toàn trong đại dịch!
Nhấp chuột vào đây để mở rộng...
Cảm ơn Chị Hương thành viên rất tích cực giúp mọi người nhiều nhé ! Chúc chị và GĐ bình an qua đại dịch!
 
Upvote 0
Yeuvoyeucon đã viết:
Cảm ơn OT đã giúp đỡ nhé, chúc bình an !
Bài đã được tự động gộp:


Cảm ơn Chị Hương thành viên rất tích cực giúp mọi người nhiều nhé ! Chúc chị và GĐ bình an qua đại dịch!
Nhấp chuột vào đây để mở rộng...
Dữ liệu lớn thì bạn có thể tham khảo code tôi viết nhé!
PHP: 
Sub CalculateData()
    Dim cnn As Object, Rst As Object
    Dim strQuery As String, fCount As Byte, X As Long
   
    Application.ScreenUpdating = False
   
    Set cnn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
   
    With cnn
        .connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0" & _
                            ";Data Source=" & ThisWorkbook.FullName & _
                            ";Extended Properties='Excel 12.0 Xml;HDR=Yes';"
        .Open
    End With
   
    strQuery = _
            "SELECT " & _
                    " [Ma NV] " & _
                    ",[Ten NV] " & _
                    ",Min([Ngay]) AS [Ngay Min] " & _
                    ",Max([Ngay]) AS [Ngay Max] " & _
                    ",Count([Ngay]) AS [Dem] " & _
                    ",Sum([Doanh so]) AS [Tong doanh so] " & _
                    ",Sum([Doanh so])/( " & _
                                        "SELECT " & _
                                                "Sum([Doanh so]) " & _
                                        "FROM " & _
                                                "[Doanh_so$] " & _
                                    ") AS [Ty trong] " & _
                    ",IIf([Tong Doanh so] >=7000,'Vuot bac',IIf([Tong Doanh so] >=5000,'Hoan thanh tot',IIf([Tong Doanh so] >=2500,'Hoan thanh','Chua hoan thanh'))) AS [Danh gia] " & _
            "FROM " & _
                    " [Doanh_so$] " & _
            "GROUP BY " & _
                    " [Ma NV] " & _
                    ",[Ten NV] "
   
    With Rst
        .activeconnection = cnn
        .Source = strQuery
        .Open
    End With
   
    With Sheet2.Range("A2")
        .CurrentRegion.Clear
        X = .CopyFromRecordset(Rst)
       
        For fCount = 1 To Rst.Fields.Count
            .Offset(-1, fCount - 1) = Rst.Fields(fCount - 1).Name
        Next fCount
       
        .Offset(, 5).Resize(X).NumberFormat = "0,000"
        .Offset(, 6).Resize(X).NumberFormat = "0.00%"
        .CurrentRegion.EntireColumn.AutoFit
    End With
   
    Rst.Close
    cnn.Close
    Set cnn = Nothing: Set Rst = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "Done", vbInformation, "GPE"
   
End Sub
 
Upvote 0
Thử với code này
Mã: 
Sub DoanhSo()
On Error Resume Next
TangToc (False)
Dim Data(), i&, Dic As Object, KQ(), t, TDS
t = Timer
Data = Range(Sheet1.[A2], Sheet1.[E10000])
TDS = Application.WorksheetFunction.Sum(Sheet1.[D2:D10000])
ReDim KQ(1 To UBound(Data), 1 To 8)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data)
    If Not Dic.exists(Data(i, 2)) Then
        k = k + 1
        Dic(Data(i, 2)) = k
        KQ(k, 1) = Data(i, 2)
        KQ(k, 2) = Data(i, 3)
        KQ(k, 4) = Data(i, 5)
        KQ(k, 5) = 1
        KQ(k, 6) = Data(i, 4)
        KQ(k, 7) = Data(i, 4) / TDS
        KQ(k, 8) = Application.WorksheetFunction.VLookup(Data(i, 4), Sheet1.[S1:T4], 2, True)
    Else
        KQ(Dic.Item(Data(i, 2)), 3) = Data(i, 5)
        KQ(Dic.Item(Data(i, 2)), 5) = KQ(Dic.Item(Data(i, 2)), 5) + 1
        KQ(Dic.Item(Data(i, 2)), 6) = KQ(Dic.Item(Data(i, 2)), 6) + Data(i, 4)
        KQ(Dic.Item(Data(i, 2)), 7) = KQ(Dic.Item(Data(i, 2)), 6) / TDS
        KQ(Dic.Item(Data(i, 2)), 8) = Application.WorksheetFunction.VLookup(KQ(Dic.Item(Data(i, 2)), 6), Sheet1.[S1:T4], 2, True)
    End If
Next
Sheet1.[I2].Resize(k - 1, 8) = KQ
TangToc (True)
MsgBox Timer - t
End Sub
Sub TangToc(ByVal bT As Boolean)
    Application.ScreenUpdating = bT
    Application.DisplayAlerts = bT
    Application.AskToUpdateLinks = bT
End Sub
Bài đã được tự động gộp:

vanthinh3101 đã viết:
Dữ liệu lớn thì bạn có thể tham khảo code tôi viết nhé!
PHP: 
Sub CalculateData()
    Dim cnn As Object, Rst As Object
    Dim strQuery As String, fCount As Byte, X As Long
 
    Application.ScreenUpdating = False
 
    Set cnn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
 
    With cnn
        .connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0" & _
                            ";Data Source=" & ThisWorkbook.FullName & _
                            ";Extended Properties='Excel 12.0 Xml;HDR=Yes';"
        .Open
    End With
 
    strQuery = _
            "SELECT " & _
                    " [Ma NV] " & _
                    ",[Ten NV] " & _
                    ",Min([Ngay]) AS [Ngay Min] " & _
                    ",Max([Ngay]) AS [Ngay Max] " & _
                    ",Count([Ngay]) AS [Dem] " & _
                    ",Sum([Doanh so]) AS [Tong doanh so] " & _
                    ",Sum([Doanh so])/( " & _
                                        "SELECT " & _
                                                "Sum([Doanh so]) " & _
                                        "FROM " & _
                                                "[Doanh_so$] " & _
                                    ") AS [Ty trong] " & _
                    ",IIf([Tong Doanh so] >=7000,'Vuot bac',IIf([Tong Doanh so] >=5000,'Hoan thanh tot',IIf([Tong Doanh so] >=2500,'Hoan thanh','Chua hoan thanh'))) AS [Danh gia] " & _
            "FROM " & _
                    " [Doanh_so$] " & _
            "GROUP BY " & _
                    " [Ma NV] " & _
                    ",[Ten NV] "
 
    With Rst
        .activeconnection = cnn
        .Source = strQuery
        .Open
    End With
 
    With Sheet2.Range("A2")
        .CurrentRegion.Clear
        X = .CopyFromRecordset(Rst)
     
        For fCount = 1 To Rst.Fields.Count
            .Offset(-1, fCount - 1) = Rst.Fields(fCount - 1).Name
        Next fCount
     
        .Offset(, 5).Resize(X).NumberFormat = "0,000"
        .Offset(, 6).Resize(X).NumberFormat = "0.00%"
        .CurrentRegion.EntireColumn.AutoFit
    End With
 
    Rst.Close
    cnn.Close
    Set cnn = Nothing: Set Rst = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Done", vbInformation, "GPE"
 
End Sub
Nhấp chuột vào đây để mở rộng...
Code ADO hay quá @vanthinh3101
Khi nào ổn ổn qua chỉ anh vài chiêu nha.
 

File đính kèm

  • Tinh toan doanh so ban hang.xlsm
    25.2 KB · Đọc: 8
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
Code ADO hay quá @vanthinh3101
Khi nào ổn ổn qua chỉ anh vài chiêu nha.
Nhấp chuột vào đây để mở rộng...
Đang dịch dã bị ghìm chân ngồi cơ quan với nhà suốt a ạ.
Chết đói đến nơi rồi a ạ.
Đoạn IIF trong strQuery có thể dùng SWITCH để thay thế nữa anh nhé!
PHP: 
Switch([Tong Doanh so] >=7000,'Vuot bac' " & _
                            ",[Tong Doanh so] >=5000,'Hoan thanh tot' " & _
                            ",[Tong Doanh so] >=2500,'Hoan thanh' " & _
                            ",True,'Chua hoan thanh') AS [Danh gia]
 
Upvote 0
Đúng là yêu vợ yêu con nên anh em vào giúp thiệt là nhiệt tình. Code cứ bay vèo vèo như kim sa chưởng.
 
Upvote 0
vanthinh3101 đã viết:
Đang dịch dã bị ghìm chân ngồi cơ quan với nhà suốt a ạ.
Chết đói đến nơi rồi a ạ.
Đoạn IIF trong strQuery có thể dùng SWITCH để thay thế nữa anh nhé!
PHP: 
Switch([Tong Doanh so] >=7000,'Vuot bac' " & _
                            ",[Tong Doanh so] >=5000,'Hoan thanh tot' " & _
                            ",[Tong Doanh so] >=2500,'Hoan thanh' " & _
                            ",True,'Chua hoan thanh') AS [Danh gia]
Nhấp chuột vào đây để mở rộng...
làm gì đến mức chết đói, thôi cố em, lờ vờ tí nhưng vẫn sống qua ngày được.
Trong code Ado của em, cái [Tong Doanh So] có thể tham chiếu để tìm đến vùng dữ liệu như trong file ko?

Maika8008 đã viết:
Đúng là yêu vợ yêu con nên anh em vào giúp thiệt là nhiệt tình. Code cứ bay vèo vèo như kim sa chưởng.
Nhấp chuột vào đây để mở rộng...
Cái tên công nhận ảnh hưởng đến nhiều vấn đề
 
Upvote 0
Upvote 0
Cá ngừ F1 đã viết:
Ah, thay vì việc phải nhập số trực tiếp trên code thì cho tham chiếu đến vùng dữ liệu luôn em.
Như kiểu dùng hàm vlookup tham chiếu thẳng đến cùng dữ liệu đó.
Nhấp chuột vào đây để mở rộng...
Em cũng không biết phải giải thích thế nào.
Nhưng khi sử dụng ADO thì dữ liệu gốc được coi là 1 database, khi tham chiếu/gọi đến thì sử dụng Title (HDR=Yes) hoặc F1,F2,... (HDR=No).
Sau khi truy vấn xong thì ghi dữ liệu ra bảng tính thì thực hiện các thủ tục như excel bình thường anh ạ.
 
Upvote 0
vanthinh3101 đã viết:
Em cũng không biết phải giải thích thế nào.
Nhưng khi sử dụng ADO thì dữ liệu gốc được coi là 1 database, khi tham chiếu/gọi đến thì sử dụng Title (HDR=Yes) hoặc F1,F2,... (HDR=No).
Sau khi truy vấn xong thì ghi dữ liệu ra bảng tính thì thực hiện các thủ tục như excel bình thường anh ạ.
Nhấp chuột vào đây để mở rộng...
Như trong code a thấy có đoạn
Mã: 
Switch([Tong Doanh so] >=7000,'Vuot bac' " & _
                            ",[Tong Doanh so] >=5000,'Hoan thanh tot' " & _
                            ",[Tong Doanh so] >=2500,'Hoan thanh' " & _
                            ",True,'Chua hoan thanh') AS [Danh gia]
Theo bài toán của tác giả thì có 4 mốc đánh giá, nhập tay thế này thì được, giờ giả sử có tầm 20 mốc, mà nhập cả vào code thì oải quá.
 
Upvote 0
Đã dùng mảng, dùng Dic thì có thể "gom" nó vào, không cần đến Application.WorksheetFunction, có thêm 1 vài vòng For ... Next cũng có sao đâu.
PHP: 
Option Explicit

Public Sub Gpe()
Dim Dic As Object, sArr(), dArr(), tArr(), DoanhSo As Double, MaNV As String
Dim I As Long, J As Long, K As Long, R As Long, R2 As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    .Range("I2:P100000").ClearContents
    tArr = .Range("S1:T4").Value
    R2 = UBound(tArr)
    sArr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 4).Value
    Rws = UBound(sArr)
    ReDim dArr(1 To Rws, 1 To 8)
    For I = 1 To Rws
        MaNV = sArr(I, 1)
        DoanhSo = DoanhSo + sArr(I, 3)
        If Not Dic.Exists(MaNV) Then
            K = K + 1
            Dic.Item(MaNV) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(I, 2)
            dArr(K, 3) = sArr(I, 4)
            dArr(K, 4) = sArr(I, 4)
            dArr(K, 5) = 1
            dArr(K, 6) = sArr(I, 3)
        Else
            R = Dic.Item(MaNV)
            If sArr(I, 4) < dArr(R, 3) Then dArr(R, 3) = sArr(I, 4)
            If sArr(I, 4) > dArr(R, 4) Then dArr(R, 4) = sArr(I, 4)
            dArr(R, 5) = dArr(R, 5) + 1
            dArr(R, 6) = dArr(R, 6) + sArr(I, 3)
        End If
    Next I
    '======================================================'
    For I = 1 To K
        If dArr(I, 6) > 0 Then dArr(I, 7) = dArr(I, 6) / DoanhSo
        For J = R2 To 1 Step -1
            If dArr(I, 6) >= tArr(J, 1) Then
                dArr(I, 8) = tArr(J, 2)
                Exit For
            End If
        Next J
    Next I
    .Range("I2").Resize(K, 8) = dArr
End With
Set Dic = Nothing
End Sub
 
Upvote 0
Ba Tê đã viết:
Đã dùng mảng, dùng Dic thì có thể "gom" nó vào, không cần đến Application.WorksheetFunction, có thêm 1 vài vòng For ... Next cũng có sao đâu.
PHP: 
Option Explicit

Public Sub Gpe()
Dim Dic As Object, sArr(), dArr(), tArr(), DoanhSo As Double, MaNV As String
Dim I As Long, J As Long, K As Long, R As Long, R2 As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    .Range("I2:P100000").ClearContents
    tArr = .Range("S1:T4").Value
    R2 = UBound(tArr)
    sArr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 4).Value
    Rws = UBound(sArr)
    ReDim dArr(1 To Rws, 1 To 8)
    For I = 1 To Rws
        MaNV = sArr(I, 1)
        DoanhSo = DoanhSo + sArr(I, 3)
        If Not Dic.Exists(MaNV) Then
            K = K + 1
            Dic.Item(MaNV) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(I, 2)
            dArr(K, 3) = sArr(I, 4)
            dArr(K, 4) = sArr(I, 4)
            dArr(K, 5) = 1
            dArr(K, 6) = sArr(I, 3)
        Else
            R = Dic.Item(MaNV)
            If sArr(I, 4) < dArr(R, 3) Then dArr(R, 3) = sArr(I, 4)
            If sArr(I, 4) > dArr(R, 4) Then dArr(R, 4) = sArr(I, 4)
            dArr(R, 5) = dArr(R, 5) + 1
            dArr(R, 6) = dArr(R, 6) + sArr(I, 3)
        End If
    Next I
    '======================================================'
    For I = 1 To K
        If dArr(I, 6) > 0 Then dArr(I, 7) = dArr(I, 6) / DoanhSo
        For J = R2 To 1 Step -1
            If dArr(I, 6) >= tArr(J, 1) Then
                dArr(I, 8) = tArr(J, 2)
                Exit For
            End If
        Next J
    Next I
    .Range("I2").Resize(K, 8) = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Sửa ngay, sửa ngay ạ, em cảm ơn bác 3T, thêm vài cái vòng lặp cũng không hề hấn gì ạ, dùng hàm trên bảng tính đúng là chậm thiệt.
Mã: 
Sub DoanhSo()
On Error Resume Next
TangToc (False)
Dim Data(), i&, k&, Dic As Object, KQ(), t, TDS, DanhGia
t = Timer
Data = Range(Sheet1.[A2], Sheet1.[E10000])
DanhGia = Range(Sheet1.[S1], Sheet1.[T4])
ReDim KQ(1 To UBound(Data), 1 To 8)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data)
    TDS = TDS + Data(i, 4)
    If Not Dic.exists(Data(i, 2)) Then
        k = k + 1
        Dic(Data(i, 2)) = k
        KQ(k, 1) = Data(i, 2)
        KQ(k, 2) = Data(i, 3)
        KQ(k, 4) = Data(i, 5)
        KQ(k, 5) = 1
        KQ(k, 6) = Data(i, 4)
    Else
        KQ(Dic.Item(Data(i, 2)), 3) = Data(i, 5)
        KQ(Dic.Item(Data(i, 2)), 5) = KQ(Dic.Item(Data(i, 2)), 5) + 1
        KQ(Dic.Item(Data(i, 2)), 6) = KQ(Dic.Item(Data(i, 2)), 6) + Data(i, 4)
    End If
Next
For i = 1 To k
    If KQ(i, 6) > 0 Then KQ(i, 7) = KQ(i, 6) / TDS
    For J = UBound(DanhGia) To 1 Step -1
        If KQ(i, 6) >= DanhGia(J, 1) Then
            KQ(i, 8) = DanhGia(J, 2)
            Exit For
        End If
    Next
Next
Sheet1.[I2].Resize(k - 1, 8) = KQ
TangToc (True)
MsgBox Timer - t
End Sub
Sub TangToc(ByVal bT As Boolean)
    Application.ScreenUpdating = bT
    Application.DisplayAlerts = bT
    Application.AskToUpdateLinks = bT
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
Như trong code a thấy có đoạn
Mã: 
Switch([Tong Doanh so] >=7000,'Vuot bac' " & _
                            ",[Tong Doanh so] >=5000,'Hoan thanh tot' " & _
                            ",[Tong Doanh so] >=2500,'Hoan thanh' " & _
                            ",True,'Chua hoan thanh') AS [Danh gia]
Theo bài toán của tác giả thì có 4 mốc đánh giá, nhập tay thế này thì được, giờ giả sử có tầm 20 mốc, mà nhập cả vào code thì oải quá.
Nhấp chuột vào đây để mở rộng...
Em cũng chưa tính đến trường hợp có 20 mốc.
Nhưng nếu các mốc thay đổi thì thực tế có thể tham chiếu đến giá trị tại bảng tính anh nhé!
Như trường hợp của chủ thớt, các mốc đang được để tại Sheets("Doanh_so"), ô S2, S3, S4.
Code sửa thành:

PHP: 
Switch([Tong Doanh so] >=" & Sheet1.Range("S4") & ",'Vuot bac' " & _
       ",[Tong Doanh so] >=" & Sheet1.Range("S3") & ",'Hoan thanh tot' " & _
       ",[Tong Doanh so] >=" & Sheet1.Range("S2") & ",'Hoan thanh' " & _
       ",True,'Chua hoan thanh') AS [Danh gia]
 
Upvote 0
Bạn có thể sử dụng Dax:
1630597326499.png
 

File đính kèm

  • Tinh toan doanh so ban hang (của YeuVoYeuCon).xlsm
    150.5 KB · Đọc: 6
Upvote 0
vanthinh3101 đã viết:
Dữ liệu lớn thì bạn có thể tham khảo code tôi viết nhé!
PHP: 
Sub CalculateData()
    Dim cnn As Object, Rst As Object
    Dim strQuery As String, fCount As Byte, X As Long
  
    Application.ScreenUpdating = False
  
    Set cnn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
  
    With cnn
        .connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0" & _
                            ";Data Source=" & ThisWorkbook.FullName & _
                            ";Extended Properties='Excel 12.0 Xml;HDR=Yes';"
        .Open
    End With
  
    strQuery = _
            "SELECT " & _
                    " [Ma NV] " & _
                    ",[Ten NV] " & _
                    ",Min([Ngay]) AS [Ngay Min] " & _
                    ",Max([Ngay]) AS [Ngay Max] " & _
                    ",Count([Ngay]) AS [Dem] " & _
                    ",Sum([Doanh so]) AS [Tong doanh so] " & _
                    ",Sum([Doanh so])/( " & _
                                        "SELECT " & _
                                                "Sum([Doanh so]) " & _
                                        "FROM " & _
                                                "[Doanh_so$] " & _
                                    ") AS [Ty trong] " & _
                    ",IIf([Tong Doanh so] >=7000,'Vuot bac',IIf([Tong Doanh so] >=5000,'Hoan thanh tot',IIf([Tong Doanh so] >=2500,'Hoan thanh','Chua hoan thanh'))) AS [Danh gia] " & _
            "FROM " & _
                    " [Doanh_so$] " & _
            "GROUP BY " & _
                    " [Ma NV] " & _
                    ",[Ten NV] "
  
    With Rst
        .activeconnection = cnn
        .Source = strQuery
        .Open
    End With
  
    With Sheet2.Range("A2")
        .CurrentRegion.Clear
        X = .CopyFromRecordset(Rst)
      
        For fCount = 1 To Rst.Fields.Count
            .Offset(-1, fCount - 1) = Rst.Fields(fCount - 1).Name
        Next fCount
      
        .Offset(, 5).Resize(X).NumberFormat = "0,000"
        .Offset(, 6).Resize(X).NumberFormat = "0.00%"
        .CurrentRegion.EntireColumn.AutoFit
    End With
  
    Rst.Close
    cnn.Close
    Set cnn = Nothing: Set Rst = Nothing
  
    Application.ScreenUpdating = True
  
    MsgBox "Done", vbInformation, "GPE"
  
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn nên thêm lệnh loại dòng rổng và xếp thứ tự theo mã
 
Upvote 0
HieuCD đã viết:
Bạn nên thêm lệnh loại dòng rổng và xếp thứ tự theo mã
Nhấp chuột vào đây để mở rộng...
Em cập nhật thêm strQuery như sau:
PHP: 
strQuery = _
            "SELECT " & _
                    " [Ma NV] " & _
                    ",[Ten NV] " & _
                    ",Min([Ngay]) AS [Ngay Min] " & _
                    ",Max([Ngay]) AS [Ngay Max] " & _
                    ",Count([Ngay]) AS [Dem] " & _
                    ",Sum([Doanh so]) AS [Tong doanh so] " & _
                    ",Sum([Doanh so])/( " & _
                                        "SELECT " & _
                                                "Sum([Doanh so]) " & _
                                        "FROM " & _
                                                "[Doanh_so$] " & _
                                    ") AS [Ty trong] " & _
                    ",IIf([Tong Doanh so] >=7000,'Vuot bac',IIf([Tong Doanh so] >=5000,'Hoan thanh tot',IIf([Tong Doanh so] >=2500,'Hoan thanh','Chua hoan thanh'))) AS [Danh gia] " & _
            "FROM " & _
                    " [Doanh_so$] " & _
            "WHERE " & _
                    " [Ma NV] IS NOT NULL " & _
            "GROUP BY " & _
                    " [Ma NV] " & _
                    ",[Ten NV] " & _
            "ORDER BY " & _
                    " [Ma NV]"
 
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

N
  • Question
Mở từng file PDF ra in rồi đóng lại mở tiếp file khác trên cùng folder
Trả lời
8
Đọc
80
Hoàng Tuấn 868
H
kiencuong030184
  • Question
ẩn hiện dòng, cột có điều kiên
Trả lời
4
Đọc
113
giaiphapexcel93@
giaiphapexcel93@
H
Kết nối vba với Database host (hiện tại đang làm host web)
2
Trả lời
24
Đọc
326
nguoiconxunui
N
A
Áp dụng Chiêu số 18: Điều khiển Conditional Formating bằng checkbox.
Trả lời
2
Đọc
25
Quang_Hải
Quang_Hải
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
1
Đọc
53
Emyeuexcel
Emyeuexcel
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom