Code vba thay thế cho hàm COUNTIFS

Liên hệ QC

dvh.hy.9902

Thành viên hoạt động
Tham gia
27/3/12
Bài viết
123
Được thích
9
- Em có vấn đề tổng hợp thống kê số lượng hàng hóa mà các nhân viên bán hàng được thưởng ở Sheets("Thuong_ban_hang"). Em có sử dụng công thức COUNTIFS để thống kê Tổng số mặt hàng bán được và Số lượng mặt hàng được thưởng; để tính tiền thưởng. Cụ thể em đã tổng hợp một số trường hợp.
- Em mong được mọi người giúp em tổng hợp bằng vba với ạ!. EM XIN TRÂN THÀNH CẢM ƠN!.
 

File đính kèm

  • Thuong doanh so.rar
    63.8 KB · Đọc: 108
Mình chưa hiểu Application.Trim lắm bạn cho ví dụ đi
Chứng tỏ nhà bác học toàn tìm hiểu cái cao siêu, cái đơn giản thì không biết! Bạn nhập ?Application.Trim(" a........b ") trong cửa sổ Immediate sẽ được "a b", còn ?Trim(" a........b ") sẽ được "a.......b" (các dấu chấm thay cho khoảng trắng do diễn đàn không cho nhập nhiều khoảng trắng liên tiếp)
 
Lần chỉnh sửa cuối:
Upvote 0
Chứng tỏ nhà bác học toàn tìm hiểu cái cao siêu, cái đơn giản thì không biết! Bạn nhập ?Application.Trim(" a........b ") trong cửa sổ Immediate sẽ được "a b", còn ?Trim(" a........b ") sẽ được "a.......b" (các dấu chấm thay cho khoảng trắng do diễn đàn không cho nhập nhiều khoảng trắng liên tiếp)
Tại chưa hiểu Application.Trim nên mới hỏi...Tự Mò học nó vậy đó.... cảm ơn bạn --=0--=0--=0
PHP:
Sub Test_Trim()
    [A2].Value = ("Kieu           Manh")
    [A3] = Application.Trim([A2])
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
bạn xem lại tên nhân viên ở 2 sheet "data" và "nhan vien", thấy thì nó giống nhau, nhưng dùng hàm nó tìm ko ra, chắc là gọ bằng 2 loại font chữ khác nha
- Anh ơi!. Sau khi sử dụng code của anh để lọc ra danh sách.
Mục đích là lọc ra những người bán được những mặt hàng có thưởng, còn những người bán những mặt hàng không có thưởng thì không cần lọc vào danh sách. Anh giúp em chỉnh lại code với!. Em cảm ơn anh.
 
Upvote 0
- Anh ơi!. Sau khi sử dụng code của anh để lọc ra danh sách.
Mục đích là lọc ra những người bán được những mặt hàng có thưởng, còn những người bán những mặt hàng không có thưởng thì không cần lọc vào danh sách. Anh giúp em chỉnh lại code với!. Em cảm ơn anh.

viết lâu rồi, ko nhớ nổi, chỉnh đại lại xem xem có đúng ko
Mã:
Option Explicit

Public Sub thuong_ban_hang()
Dim data, NV, KQ As Variant, R_NV As Range, i, j, k, tong_so_hang, tong_so_hang_thuong As Long, dic As Object, r

ReDim KQ(1 To 6000, 1 To 8)

With Sheets("Nhan_vien")
    Set R_NV = .Range(.[c3], .[c60000].End(3))
    NV = R_NV.Resize(, 2).Value
End With

With Sheets("DATA")
    data = Range(.[ah6], .[ak60000].End(3)).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(data)
    If data(i, 2) <> "" Then
    If UCase(Left(data(i, 4), 1)) = "C" Then
    If Not dic.exists(data(i, 2)) Then
        k = k + 1
        dic.Add data(i, 2), k
        KQ(k, 1) = k
        KQ(k, 2) = data(i, 2)
        r = Application.Match(data(i, 2), R_NV, 0)
            If TypeName(r) <> "Error" Then
                KQ(k, 3) = NV(r, 2)
            Else
                KQ(k, 3) = "Ko co nhan vien nay trong danh sach"
            End If
        KQ(k, 4) = 1: tong_so_hang = tong_so_hang + 1
         KQ(k, 5) = 1: tong_so_hang_thuong = tong_so_hang_thuong + 1
        KQ(k, 7) = "=RC[-2]*RC[-1]"
    Else
    j = dic.Item(data(i, 2))
        KQ(j, 4) = KQ(j, 4) + 1: tong_so_hang = tong_so_hang + 1
        If UCase(Left(data(i, 4), 1)) = "C" Then KQ(k, 5) = KQ(j, 5) + 1: tong_so_hang_thuong = tong_so_hang_thuong + 1
    End If
    End If
    End If
Next i
k = k + 1
KQ(k, 2) = "Tong"
KQ(k, 4) = tong_so_hang
KQ(k, 5) = tong_so_hang_thuong
KQ(k, 7) = "=SUM(R[-" & k - 1 & "]C:R[-1]C)"

With Sheets("Thuong_ban_hang")
.[a11:H6000].Clear
.[a11].Resize(k, 8) = KQ
.[a11].Resize(k, 8).Borders.Weight = xlThin
End With
End Sub
 
Upvote 0
viết lâu rồi, ko nhớ nổi, chỉnh đại lại xem xem có đúng ko
Mã:
Option Explicit

Public Sub thuong_ban_hang()
Dim data, NV, KQ As Variant, R_NV As Range, i, j, k, tong_so_hang, tong_so_hang_thuong As Long, dic As Object, r

ReDim KQ(1 To 6000, 1 To 8)

With Sheets("Nhan_vien")
    Set R_NV = .Range(.[c3], .[c60000].End(3))
    NV = R_NV.Resize(, 2).Value
End With

With Sheets("DATA")
    data = Range(.[ah6], .[ak60000].End(3)).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(data)
    If data(i, 2) <> "" Then
    If UCase(Left(data(i, 4), 1)) = "C" Then
    If Not dic.exists(data(i, 2)) Then
        k = k + 1
        dic.Add data(i, 2), k
        KQ(k, 1) = k
        KQ(k, 2) = data(i, 2)
        r = Application.Match(data(i, 2), R_NV, 0)
            If TypeName(r) <> "Error" Then
                KQ(k, 3) = NV(r, 2)
            Else
                KQ(k, 3) = "Ko co nhan vien nay trong danh sach"
            End If
        KQ(k, 4) = 1: tong_so_hang = tong_so_hang + 1
         KQ(k, 5) = 1: tong_so_hang_thuong = tong_so_hang_thuong + 1
        KQ(k, 7) = "=RC[-2]*RC[-1]"
    Else
    j = dic.Item(data(i, 2))
        KQ(j, 4) = KQ(j, 4) + 1: tong_so_hang = tong_so_hang + 1
        If UCase(Left(data(i, 4), 1)) = "C" Then KQ(k, 5) = KQ(j, 5) + 1: tong_so_hang_thuong = tong_so_hang_thuong + 1
    End If
    End If
    End If
Next i
k = k + 1
KQ(k, 2) = "Tong"
KQ(k, 4) = tong_so_hang
KQ(k, 5) = tong_so_hang_thuong
KQ(k, 7) = "=SUM(R[-" & k - 1 & "]C:R[-1]C)"

With Sheets("Thuong_ban_hang")
.[a11:H6000].Clear
.[a11].Resize(k, 8) = KQ
.[a11].Resize(k, 8).Borders.Weight = xlThin
End With
End Sub
- Anh ơi!.
- Em đã chuẩn hóa lại dữ liệu giữa sheet(Nhan_vien) và sheet(DATA) rồi chạy code bài #28 code như trong file đính kèm thì kết quả không đúng như em tét bằng công thức ở sheet(Thuong_ban_hang (2)).
- Em tải lại file đính kèm, mong Anh và mọi người xem giúp em với.
 

File đính kèm

  • Thuong doanh so_2.rar
    46.7 KB · Đọc: 13
Upvote 0
- Câu lệnh này:
If UCase(Left(data(i, 4), 1)) = "C" Then
đặt trong code như trên bài #28 thì lọc ra những người bán được những mặt hàng có thưởng. Tuy nhiên tại cột tổng các mặt hàng bán được thì không còn chính xác nữa [Tổng các mặt hàng bán được bao gồm cả có thưởng, không thưởng và không ghi gì ở cột Ak của sheet(DATA)]. Em mần mãi mà chẳng biets sửa làm sao. Mọi người giúp em với.
 
Lần chỉnh sửa cuối:
Upvote 0
- Câu lệnh này:
đặt trong code như trên bài #28 thì lọc ra những người bán được những mặt hàng có thưởng. Tuy nhiên tại cột tổng các mặt hàng bán được thì không còn chính xác nữa. Em mần mãi mà chẳng biets sửa làm sao. Mọi người giúp em với.
hôm nay Chủ Nhật không ai xem bài viết của bạn cũng không có gì lạ . bạn muốn đợi Let's Gâu Gâu thì có thể chiều tối hoặc mai người ta nghỉ cuối tuần xong rồi người ta giúp bạn
 
Upvote 0
hôm nay Chủ Nhật không ai xem bài viết của bạn cũng không có gì lạ . bạn muốn đợi Let's Gâu Gâu thì có thể chiều tối hoặc mai người ta nghỉ cuối tuần xong rồi người ta giúp bạn
- Hôm trước Let's Gâu Gâu làm cho mình do dữ liệu mình giả lập không đề phòng được hết các trường hợp. Mình cũng không nghĩ ra. Hồi hôm lọc danh sách trình sếp ký duyệt thì mới thấy là chỉ cần lọc tên người ứng với các mặt hàng được thưởng.
- Trong khi mong đợi cách giải của anh Let's Gâu Gâu. Bạn giúp mình một cách với!.
 
Upvote 0
- Hôm trước Let's Gâu Gâu làm cho mình do dữ liệu mình giả lập không đề phòng được hết các trường hợp. Mình cũng không nghĩ ra. Hồi hôm lọc danh sách trình sếp ký duyệt thì mới thấy là chỉ cần lọc tên người ứng với các mặt hàng được thưởng.
- Trong khi mong đợi cách giải của anh Let's Gâu Gâu. Bạn giúp mình một cách với!.

bạn hỏi tôi giải pháp thay vì Let's Gâu Gâu chẳng khác nào bỏ ngọc lấy đá
mấy cái zụ này tôi đâu có biết làm mà chỉ được bạn
Let's Gâu Gâu đã có tham gia thì sẽ không để bạn bơ vơ đâu mà sợ
 
Upvote 0
bạn hỏi tôi giải pháp thay vì Let's Gâu Gâu chẳng khác nào bỏ ngọc lấy đá
mấy cái zụ này tôi đâu có biết làm mà chỉ được bạn
Let's Gâu Gâu đã có tham gia thì sẽ không để bạn bơ vơ đâu mà sợ
- Tôi đâu nói là thay?. Chỉ mong với bài của tôi nếu nhiều cách làm thì đó cũng chính là các giải pháp mà tôi được học hỏi thêm!.
 
Upvote 0
- Anh ơi!.
- Em đã chuẩn hóa lại dữ liệu giữa sheet(Nhan_vien) và sheet(DATA) rồi chạy code bài #28 code như trong file đính kèm thì kết quả không đúng như em tét bằng công thức ở sheet(Thuong_ban_hang (2)).
- Em tải lại file đính kèm, mong Anh và mọi người xem giúp em với.

Nhâm nhi trong lúc chờ đợi
Mã:
Public Sub Co_Khong()
Dim DSach, Tam(), kq(), r As Long, i

DSach = Sheet3.Range("AI6", Sheet3.Range("AK1000000").End(xlUp))
Tam = Sheet2.Range("C3", Sheet2.Range("D1000000").End(xlUp))

With CreateObject("scripting.dictionary")
For r = 1 To UBound(Tam)
.Add Tam(r, 1), Array(Tam(r, 2), 0, 0)
Next r
ReDim Tam(2)

For r = 1 To UBound(DSach)
If DSach(r, 1) <> "" And DSach(r, 3) <> "" Then
Tam = .Item(DSach(r, 1))
Tam(1) = Tam(1) + 1
If Left(DSach(r, 3), 1) = "C" Then Tam(2) = Tam(2) + 1
.Item(DSach(r, 1)) = Tam
End If
Next r
Tam = .keys
ReDim kq(1 To .Count + 1, 1 To 4)

For r = 0 To UBound(Tam)
If .Item(Tam(r))(1) + .Item(Tam(r))(2) > 0 Then
i = i + 1
kq(i, 1) = Tam(r)
kq(i, 2) = .Item(Tam(r))(0)
kq(i, 3) = .Item(Tam(r))(1)
kq(i, 4) = .Item(Tam(r))(2)
kq(.Count + 1, 3) = kq(.Count + 1, 3) + .Item(Tam(r))(1)
kq(.Count + 1, 4) = kq(.Count + 1, 4) + .Item(Tam(r))(2)
End If
Next r
kq(i + 1, 1) = "Tong"
kq(i + 1, 3) = kq(.Count + 1, 3)
kq(i + 1, 4) = kq(.Count + 1, 4)
End With

Sheet1.Range("A11", "H" & Sheet1.Range("B1000000").End(xlUp).Row).Clear
Sheet1.Range("B11").Resize(i + 1, 4) = kq
Sheet1.Range("A11").Resize(i) = "=row()-10"
Sheet1.Range("G11").Resize(i) = "=RC[-2]*RC[-1]"
End Sub
 
Upvote 0
Nhâm nhi trong lúc chờ đợi

Gtri làm thì ok rồi, còn chờ đợi gì nữa, có điều sao phải xài tới 3 vòng lặp, bỏ bớt được ko?

============
hôm nay Chủ Nhật không ai xem bài viết của bạn cũng không có gì lạ . bạn muốn đợi Let's Gâu Gâu thì có thể chiều tối hoặc mai người ta nghỉ cuối tuần xong rồi người ta giúp bạn
sáng thứ 7, cn phải d0i "chăn" con gái học av..........
 
Lần chỉnh sửa cuối:
Upvote 0
Nhâm nhi trong lúc chờ đợi
Mã:
Public Sub Co_Khong()
Dim DSach, Tam(), kq(), r As Long, i

DSach = Sheet3.Range("AI6", Sheet3.Range("AK1000000").End(xlUp))
Tam = Sheet2.Range("C3", Sheet2.Range("D1000000").End(xlUp))

With CreateObject("scripting.dictionary")
For r = 1 To UBound(Tam)
.Add Tam(r, 1), Array(Tam(r, 2), 0, 0)
Next r
ReDim Tam(2)

For r = 1 To UBound(DSach)
If DSach(r, 1) <> "" And DSach(r, 3) <> "" Then
Tam = .Item(DSach(r, 1))
Tam(1) = Tam(1) + 1
If Left(DSach(r, 3), 1) = "C" Then Tam(2) = Tam(2) + 1
.Item(DSach(r, 1)) = Tam
End If
Next r
Tam = .keys
ReDim kq(1 To .Count + 1, 1 To 4)

For r = 0 To UBound(Tam)
If .Item(Tam(r))(1) + .Item(Tam(r))(2) > 0 Then
i = i + 1
kq(i, 1) = Tam(r)
kq(i, 2) = .Item(Tam(r))(0)
kq(i, 3) = .Item(Tam(r))(1)
kq(i, 4) = .Item(Tam(r))(2)
kq(.Count + 1, 3) = kq(.Count + 1, 3) + .Item(Tam(r))(1)
kq(.Count + 1, 4) = kq(.Count + 1, 4) + .Item(Tam(r))(2)
End If
Next r
kq(i + 1, 1) = "Tong"
kq(i + 1, 3) = kq(.Count + 1, 3)
kq(i + 1, 4) = kq(.Count + 1, 4)
End With

Sheet1.Range("A11", "H" & Sheet1.Range("B1000000").End(xlUp).Row).Clear
Sheet1.Range("B11").Resize(i + 1, 4) = kq
Sheet1.Range("A11").Resize(i) = "=row()-10"
Sheet1.Range("G11").Resize(i) = "=RC[-2]*RC[-1]"
End Sub
- Cảm ơn bạn đã thêm một cách viêt. Có một vài chỗ trong cách viết của bạn mà mình chưa hiểu được mình sẽ tìm hiểu ngay.
- Anh Let's Gâu Gâu sửa lại code giúp em, em nhìn code của Anh đối với bài này cũng đã quen. Mong anh sửa lại giúp để em áp dụng ngay.
- Còn các phương án mà các bạn khác giúp mình, mình sẽ tìm hiểu và học từ từ mới được.
 
Upvote 0
Nhâm nhi trong lúc chờ đợi
Mã:
Public Sub Co_Khong()
Dim DSach, Tam(), kq(), r As Long, i

DSach = Sheet3.Range("AI6", Sheet3.Range("AK1000000").End(xlUp))
Tam = Sheet2.Range("C3", Sheet2.Range("D1000000").End(xlUp))

With CreateObject("scripting.dictionary")
For r = 1 To UBound(Tam)
.Add Tam(r, 1), Array(Tam(r, 2), 0, 0)
Next r
ReDim Tam(2)

For r = 1 To UBound(DSach)
If DSach(r, 1) <> "" And DSach(r, 3) <> "" Then
Tam = .Item(DSach(r, 1))
Tam(1) = Tam(1) + 1
If Left(DSach(r, 3), 1) = "C" Then Tam(2) = Tam(2) + 1
.Item(DSach(r, 1)) = Tam
End If
Next r
Tam = .keys
ReDim kq(1 To .Count + 1, 1 To 4)

For r = 0 To UBound(Tam)
If .Item(Tam(r))(1) + .Item(Tam(r))(2) > 0 Then
i = i + 1
kq(i, 1) = Tam(r)
kq(i, 2) = .Item(Tam(r))(0)
kq(i, 3) = .Item(Tam(r))(1)
kq(i, 4) = .Item(Tam(r))(2)
kq(.Count + 1, 3) = kq(.Count + 1, 3) + .Item(Tam(r))(1)
kq(.Count + 1, 4) = kq(.Count + 1, 4) + .Item(Tam(r))(2)
End If
Next r
kq(i + 1, 1) = "Tong"
kq(i + 1, 3) = kq(.Count + 1, 3)
kq(i + 1, 4) = kq(.Count + 1, 4)
End With

Sheet1.Range("A11", "H" & Sheet1.Range("B1000000").End(xlUp).Row).Clear
Sheet1.Range("B11").Resize(i + 1, 4) = kq
Sheet1.Range("A11").Resize(i) = "=row()-10"
Sheet1.Range("G11").Resize(i) = "=RC[-2]*RC[-1]"
End Sub
- Mình không hiểu lắm, nhưng có chỉnh lại một chút thì Thấy kết quả đúng như mình làm bằng công thức:
Mã:
Public Sub Co_Khong()    Dim DSach, Tam(), kq(), r As Long, i
    DSach = Sheet3.Range("AI6", Sheet3.Range("AK1000000").End(xlUp))
    Tam = Sheet2.Range("C3", Sheet2.Range("D1000000").End(xlUp))
    With CreateObject("scripting.dictionary")
        For r = 1 To UBound(Tam)
            .Add Tam(r, 1), Array(Tam(r, 2), 0, 0)
        Next r
        ReDim Tam(2)
        For r = 1 To UBound(DSach)
            If DSach(r, 1) <> "" Then 'And DSach(r, 3) <> ""
                Tam = .Item(DSach(r, 1))
                Tam(1) = Tam(1) + 1
                If Left(DSach(r, 3), 1) = "C" Then Tam(2) = Tam(2) + 1
                .Item(DSach(r, 1)) = Tam
            End If
        Next r
        Tam = .keys
        ReDim kq(1 To .Count + 1, 1 To 4)
        For r = 0 To UBound(Tam)
            If .Item(Tam(r))(1) + .Item(Tam(r))(2) > 0 Then
                i = i + 1
                kq(i, 1) = Tam(r)
                kq(i, 2) = .Item(Tam(r))(0)
                kq(i, 3) = .Item(Tam(r))(1)
                kq(i, 4) = .Item(Tam(r))(2)
                kq(.Count + 1, 3) = kq(.Count + 1, 3) + .Item(Tam(r))(1)
                kq(.Count + 1, 4) = kq(.Count + 1, 4) + .Item(Tam(r))(2)
            End If
        Next r
        kq(i + 1, 1) = "Tong"
        kq(i + 1, 3) = kq(.Count + 1, 3)
        kq(i + 1, 4) = kq(.Count + 1, 4)
    End With
    Sheet1.Range("A11", "H" & Sheet1.Range("B1000000").End(xlUp).Row).Clear
    Sheet1.Range("B11").Resize(i + 1, 4) = kq
    Sheet1.Range("A11").Resize(i) = "=row()-10"
    Sheet1.Range("G11").Resize(i) = "=RC[-2]*RC[-1]"
End Sub
- Mong được bạn hướng dẫn giải thích hoặc chỉ giúp mình ý nghĩa của các câu lệnh sau để mình áp dụng với!.
.Add Tam(r, 1), Array(Tam(r, 2), 0, 0)
- Mảng ReDim Tam(2) là mảng có mấy phần tử ?
- Còn câu này? Tam = .keys có nghĩa là gì a.?
Cảm ơn bạn đã giúp mình
 
Lần chỉnh sửa cuối:
Upvote 0
- Mong được bạn hướng dẫn giải thích hoặc chỉ giúp mình ý nghĩa của các câu lệnh sau để mình áp dụng với!.

- Mảng ReDim Tam(2) là mảng có mấy phần tử ?
- Còn câu này? Tam = .keys có nghĩa là gì a.?
Cảm ơn bạn đã giúp mình
theo tôi nếu bạn không hiểu dòng
Mã:
ReDim Tam(2)
thì bạn nên xóa luôn dòng đó chạy thử xem =))
lúc này là đưa vô
Mã:
.Add Tam(r, 1), [COLOR=#ff0000][B]Array(Tam(r, 2), 0, 0[/B][/COLOR][COLOR=#000000])[/COLOR][COLOR=#ff0000][/COLOR]
lúc này là lấy ra sử dụng
Mã:
[COLOR=#ff0000][B]Tam[/B][/COLOR] = .Item(DSach(r, 1))
giá trị của Tam màu đỏ ở dưới chính là cái thằng màu đỏ ở trên đấy
 
Upvote 0
- Bạn gtri ơi mình đã kiểm tra lại:
+ Nếu mình bỏ đi dòng này
trong code của bạn thì code vẫn lọc những người có mặt hàng không có thưởng, như vậy là không được. Còn để nguyên thì ở cột tổng các mặt hàng báng được là không chính xác.
+ bạn xem lại giúp mình với!.Ket quả bang cong thuc.jpg
Ket quả chay code.jpg
 

File đính kèm

  • Thuong doanh so_3.rar
    45.3 KB · Đọc: 22
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom