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: 7
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

H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
19K
DeTong
D
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
13
Đọc
257
Tuấn Bụng Bự
Tuấn Bụng Bự
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
276
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
244
ptm0412
ptm0412
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
0
Đọc
34
dung09031989
dung09031989
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
1
Đọc
40
tranvansau278
T
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
0
Đọc
36
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
33
hoangminhtien
hoangminhtien
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
0
Đọc
144
GPE-Trợ Lý
GPE-Trợ Lý
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
2
Đọc
74
phutdm
P
dunghtgiga
  • Đã khóa
Tính bốn tuần cho một tháng
Trả lời
9
Đọc
265
ptm0412
ptm0412
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
3
Đọc
101
HUONGHCKT
H
Mr Đạo
in giấy ra bị lệch xuống dưới
    • Thích
2
Trả lời
29
Đọc
26K
Hoàng Tuấn 868
H
H
Không xem được ảnh trên Excel
Trả lời
3
Đọc
1K
huyentran9292
H
T
Xin form quản lý dữ liệu học viên của Trung tâm Đào tạo
Trả lời
2
Đọc
217
hakiru188
H
C
Code Lọc Dữ Liệu
Trả lời
10
Đọc
175
Cúc Hr
C
Y
Cách ẩn công thức 1 ô trong sheet
Trả lời
8
Đọc
119
hoangminhtien
hoangminhtien
vuha
  • Question
Lỗi chọn dòng thứ 6 trong sheet được chọn: rows("6:6").select
Trả lời
12
Đọc
160
ptm0412
ptm0412
Nguyencaocuong86
Tô màu dữ liệu trùng lặp trong excel.
Trả lời
10
Đọc
144
Nguyencaocuong86
Nguyencaocuong86
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

Back
Top Bottom