Vba thay thế hàm Countifs.

kh0jy3n

Thành viên thường trực
Tham gia ngày
21 Tháng tư 2012
Bài viết
323
Được thích
110
Điểm
395
Nơi ở
Thủy Nguyên - Hải phòng
Gửi các Bác.
Hiện tại em đang làm một file báo biểu dùng rất nhiều tới hàm Countifs , tới tầm 60.000 dong làm file chạy chậm quá.
về khoản Vba em ngủ quá :(.
bác nào rảnh viết hộ em xin code hàm countifs em có để Vd ở file đính kèm ạ.

Em cảm ơn !
 

File đính kèm

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,633
Được thích
2,533
Điểm
360
Gửi các Bác.
Hiện tại em đang làm một file báo biểu dùng rất nhiều tới hàm Countifs , tới tầm 60.000 dong làm file chạy chậm quá.
về khoản Vba em ngủ quá :(.
bác nào rảnh viết hộ em xin code hàm countifs em có để Vd ở file đính kèm ạ.

Em cảm ơn !
Dùng dictionary là được
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,633
Được thích
2,533
Điểm
360
Gửi các Bác.
Hiện tại em đang làm một file báo biểu dùng rất nhiều tới hàm Countifs , tới tầm 60.000 dong làm file chạy chậm quá.
về khoản Vba em ngủ quá :(.
bác nào rảnh viết hộ em xin code hàm countifs em có để Vd ở file đính kèm ạ.

Em cảm ơn !
Bạn xem code nhé.Mà sao mình thấy khác kết quả nhỉ.Hay là mình không hiểu câu hỏi.
Mã:
Sub dem()
Dim i As Long, j As Long, lr As Long, arr, arr1, dic As Object, lr1 As Long, b As Long, c As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("TONG HOP")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 4 Then Exit Sub
     .Range("C4:h" & lr).ClearContents
     arr = .Range("B3:H" & lr).Value
     For i = 2 To UBound(arr, 1)
         dic.Add arr(i, 1), i
     Next i
     For i = 2 To UBound(arr, 2)
         dic.Add arr(1, i), i
     Next i
End With
With Sheets("DANH SACH")
     lr1 = .Range("C" & Rows.Count).End(xlUp).Row
     arr1 = .Range("c3:e" & lr1).Value
     For i = 1 To UBound(arr1, 1)
         b = dic.Item(arr1(i, 1))
         If b Then
            For j = 2 To 3
                 c = dic.Item(arr1(i, j))
                 If c Then
                    arr(b, c) = arr(b, c) + 1
                 End If
            Next j
         End If
      Next i
End With
With Sheets("TONG HOP")
     .Range("B3:H" & lr).Value = arr
End With
End Sub
Bài đã được tự động gộp:

Sao bài của bạn nhiều vòng lặp lồng nhau vậy.Có tới 3 cái.Nếu dữ liệu là 60 nghìn dòng thì nó có tận.60000*6000*6 phép tính.:D
 
Lần chỉnh sửa cuối:

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
11,604
Được thích
17,584
Điểm
1,860
Cũng chưa cần đến Dictionary:
PHP:
Sub Array_()
 Dim Rws As Long, J As Long, W As Integer:          Dim Arr()
 
 Arr() = Sheets("Danh Sach").[B3].CurrentRegion.Offset(1, 1).Value
 ReDim dArr(1 To 5, 1 To 7)
 For J = 1 To UBound(Arr())
    If Arr(J, 1) = "" Then Exit For
    W = Right(Arr(J, 2), 1)
    dArr(W, 1) = Arr(J, 2)
    If Arr(J, 3) = "NAM" Then
        dArr(W, 2) = dArr(W, 2) + 1
    Else
        dArr(W, 3) = dArr(W, 3) + 1
    End If
    If Len(Arr(J, 4)) > 5 And Not IsNumeric(Arr(J, 4)) Then
        dArr(W, 6) = dArr(W, 6) + 1
    ElseIf Len(Arr(J, 4)) < 3 Then
        dArr(W, 7) = dArr(W, 7) + 1
    Else
        If Hour(Arr(J, 4)) >= 18 Then
            dArr(W, 5) = dArr(W, 5) + 1
        Else
            dArr(W, 4) = dArr(W, 4) + 1
        End If
    End If
 Next J
 Sheets("Tong Hop").[b4].Resize(5, 7).Value = dArr()
End Sub
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,633
Được thích
2,533
Điểm
360
Cũng chưa cần đến Dictionary:
PHP:
Sub Array_()
Dim Rws As Long, J As Long, W As Integer:          Dim Arr()

Arr() = Sheets("Danh Sach").[B3].CurrentRegion.Offset(1, 1).Value
ReDim dArr(1 To 5, 1 To 7)
For J = 1 To UBound(Arr())
    If Arr(J, 1) = "" Then Exit For
    W = Right(Arr(J, 2), 1)
    dArr(W, 1) = Arr(J, 2)
    If Arr(J, 3) = "NAM" Then
        dArr(W, 2) = dArr(W, 2) + 1
    Else
        dArr(W, 3) = dArr(W, 3) + 1
    End If
    If Len(Arr(J, 4)) > 5 And Not IsNumeric(Arr(J, 4)) Then
        dArr(W, 6) = dArr(W, 6) + 1
    ElseIf Len(Arr(J, 4)) < 3 Then
        dArr(W, 7) = dArr(W, 7) + 1
    Else
        If Hour(Arr(J, 4)) >= 18 Then
            dArr(W, 5) = dArr(W, 5) + 1
        Else
            dArr(W, 4) = dArr(W, 4) + 1
        End If
    End If
Next J
Sheets("Tong Hop").[b4].Resize(5, 7).Value = dArr()
End Sub
Em chưa test nhưng mà nếu mà có C11 thì nó có lỗi không nhỉ anh.Mà ví dụ nó không có C2 thì bị cách dòng anh.
 
Lần chỉnh sửa cuối:

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,272
Được thích
4,919
Điểm
560
Em chưa test nhưng mà nếu mà có C11 thì nó có lỗi không nhỉ anh.Mà ví dụ nó không có C2 thì bị cách dòng anh.
Người ta làm chỉ cho đúng dữ liệu giả dụ ấy thôi. Nếu có C37, hay không chỉ C, hoặc C1, ..., C5, NK51, BT64 v...v thì tèo.

Viết code nên luôn coi dữ liệu chỉ là giả dụ.
 

tam888

Thành viên tích cực
Tham gia ngày
22 Tháng tám 2013
Bài viết
840
Được thích
503
Điểm
560
Người ta làm chỉ cho đúng dữ liệu giả dụ ấy thôi. Nếu có C37, hay không chỉ C, hoặc C1, ..., C5, NK51, BT64 v...v thì tèo.

Viết code nên luôn coi dữ liệu chỉ là giả dụ.
Nhưng đôi khi căn cứ vào dữ liệu quy luật thì giúp code thuận hơn - còn sai là do người hỏi hay lười cứ làm giả số liệu kiểu làm đại cho nhanh 1 2 3 hay a b c 1 2 3... không làm dữ liệu giả định tổng quát và gần thực tế
 

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,272
Được thích
4,919
Điểm
560
Nhưng đôi khi căn cứ vào dữ liệu quy luật thì giúp code thuận hơn - còn sai là do người hỏi hay lười cứ làm giả số liệu kiểu làm đại cho nhanh 1 2 3 hay a b c 1 2 3... không làm dữ liệu giả định tổng quát và gần thực tế
Tất nhiên nhưng nhìn A1..A9, C1..C5 tôi có cảm giác là dữ liệu giả lập, người hỏi lười soạn dữ liệu. Với dữ liệu kiểu đó tôi luôn cảnh giác, và cho là dữ liệu thực có thể rất khác.
 

FPT_online

Thành viên hoạt động
Tham gia ngày
27 Tháng mười 2013
Bài viết
133
Được thích
16
Điểm
370
Tuổi
37
Lần chỉnh sửa cuối:

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,976
Được thích
13,611
Điểm
1,560
Bạn xem code nhé.Mà sao mình thấy khác kết quả nhỉ.Hay là mình không hiểu câu hỏi.
Mã:
Sub dem()
Dim i As Long, j As Long, lr As Long, arr, arr1, dic As Object, lr1 As Long, b As Long, c As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("TONG HOP")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 4 Then Exit Sub
     .Range("C4:h" & lr).ClearContents
     arr = .Range("B3:H" & lr).Value
     For i = 2 To UBound(arr, 1)
         dic.Add arr(i, 1), i
     Next i
     For i = 2 To UBound(arr, 2)
         dic.Add arr(1, i), i
     Next i
End With
With Sheets("DANH SACH")
     lr1 = .Range("C" & Rows.Count).End(xlUp).Row
     arr1 = .Range("c3:e" & lr1).Value
     For i = 1 To UBound(arr1, 1)
         b = dic.Item(arr1(i, 1))
         If b Then
            For j = 2 To 3
                 c = dic.Item(arr1(i, j))
                 If c Then
                    arr(b, c) = arr(b, c) + 1
                 End If
            Next j
         End If
      Next i
End With
With Sheets("TONG HOP")
     .Range("B3:H" & lr).Value = arr
End With
End Sub
:D
Kết quả lệch do công thức trong file sai
 

FPT_online

Thành viên hoạt động
Tham gia ngày
27 Tháng mười 2013
Bài viết
133
Được thích
16
Điểm
370
Tuổi
37
Sao bài của bạn nhiều vòng lặp lồng nhau vậy.Có tới 3 cái.Nếu dữ liệu là 60 nghìn dòng thì nó có tận.60000*6000*6 phép tính.:D
Hi tại vì mình thấy code của bạn chưa tận dụng được cái item của dic nên nó mới tốn vòng lặp vậy à.
Thời gian xử lý code như nhau, mỗi người 1 cách viết khác nhau thôi, không biết bạn giỏi tới đâu mà tính toán như đúng rồi. Còn đi cười người khác nữa
 
Lần chỉnh sửa cuối:

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
11,604
Được thích
17,584
Điểm
1,860
Người ta làm chỉ cho đúng dữ liệu giả dụ ấy thôi. Nếu có C37, hay không chỉ C, hoặc C1, ..., C5, NK51, BT64 v...v thì tèo.
Viết code nên luôn coi dữ liệu chỉ là giả dụ.
Tết nhất thêm rảnh rỗi mà!
Dữ liệu thế nào làm thế í cái đã; Nếu DL khác thì chế lại; mấy khi được thêm bài mới.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,633
Được thích
2,533
Điểm
360
Thời gian xử lý code như nhau, mỗi người 1 cách viết khác nhau thôi, không biết bạn giỏi tới đâu mà tính toán như đúng rồi. Còn đi cười người khác nữa
Bạn thử dữ liệu với 60000 dòng ở trang dữ liệu và 1000 dòng ở trang kết quả xem thế nào.Mình không cười ai cả mình thấy thế góp ý cho bạn thôi.Nêu bạn không thích thì thôi mình xin lỗi.
 

Ba Tê

Gội Rồi Mới Cạo
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,648
Được thích
16,660
Điểm
1,860
Tuổi
61
Nơi ở
An Giang
Gửi các Bác.
Hiện tại em đang làm một file báo biểu dùng rất nhiều tới hàm Countifs , tới tầm 60.000 dong làm file chạy chậm quá.
về khoản Vba em ngủ quá :(.
bác nào rảnh viết hộ em xin code hàm countifs em có để Vd ở file đính kèm ạ.

Em cảm ơn !
Viết thí thí cho vui.
 

File đính kèm

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,976
Được thích
13,611
Điểm
1,560
Gửi các Bác.
Hiện tại em đang làm một file báo biểu dùng rất nhiều tới hàm Countifs , tới tầm 60.000 dong làm file chạy chậm quá.
về khoản Vba em ngủ quá :(.
bác nào rảnh viết hộ em xin code hàm countifs em có để Vd ở file đính kèm ạ.

Em cảm ơn !
Thêm cách dùng Instr
Theo cách gọi tên cột và dòng trong file
Mã:
Sub GPE()
  Dim i As Long, j As Long, iR As Long, jC As Long
  Dim sArr(), Res(), rowStr As String, colStr As String

  With Sheets("TONG HOP")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 4 Then Exit Sub
    sArr = .Range("B3:H" & i).Value
  End With
  ReDim Res(1 To UBound(sArr) - 1, 1 To 6)
  rowStr = "##": colStr = "##"
  For i = 2 To UBound(sArr, 1)
    rowStr = rowStr & Right(sArr(i, 1), 2)
  Next i
  For j = 2 To UBound(sArr, 2)
    colStr = colStr & Right(sArr(1, j), 2)
  Next j
  With Sheets("DANH SACH")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    If i < 3 Then Exit Sub
    sArr = .Range("C3:E" & i).Value
  End With
  For i = 1 To UBound(sArr, 1)
    iR = InStr(1, rowStr, Right(sArr(i, 1), 2)) \ 2
    If iR > 0 Then
      For j = 2 To 3
        jC = InStr(1, colStr, Right(sArr(i, j), 2)) \ 2
        If jC > 0 Then Res(iR, jC) = Res(iR, jC) + 1
      Next j
    End If
  Next i
  With Sheets("TONG HOP")
    .Range("C4").Resize(UBound(Res), UBound(Res, 2)) = Res
  End With
End Sub
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,633
Được thích
2,533
Điểm
360
Thêm cách dùng Instr
Theo cách gọi tên cột và dòng trong file
Mã:
Sub GPE()
  Dim i As Long, j As Long, iR As Long, jC As Long
  Dim sArr(), Res(), rowStr As String, colStr As String

  With Sheets("TONG HOP")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 4 Then Exit Sub
    sArr = .Range("B3:H" & i).Value
  End With
  ReDim Res(1 To UBound(sArr) - 1, 1 To 6)
  rowStr = "##": colStr = "##"
  For i = 2 To UBound(sArr, 1)
    rowStr = rowStr & Right(sArr(i, 1), 2)
  Next i
  For j = 2 To UBound(sArr, 2)
    colStr = colStr & Right(sArr(1, j), 2)
  Next j
  With Sheets("DANH SACH")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    If i < 3 Then Exit Sub
    sArr = .Range("C3:E" & i).Value
  End With
  For i = 1 To UBound(sArr, 1)
    iR = InStr(1, rowStr, Right(sArr(i, 1), 2)) \ 2
    If iR > 0 Then
      For j = 2 To 3
        jC = InStr(1, colStr, Right(sArr(i, j), 2)) \ 2
        If jC > 0 Then Res(iR, jC) = Res(iR, jC) + 1
      Next j
    End If
  Next i
  With Sheets("TONG HOP")
    .Range("C4").Resize(UBound(Res), UBound(Res, 2)) = Res
  End With
End Sub
Em không hiểu sao lại phải lấy là 2 ký tự hả anh.Nếu có trường hợp 2 ký tự cuối giống nhau thì sao.
 

kh0jy3n

Thành viên thường trực
Tham gia ngày
21 Tháng tư 2012
Bài viết
323
Được thích
110
Điểm
395
Nơi ở
Thủy Nguyên - Hải phòng
@@
Em cảm ơn mọi người nhiều ạ.
Chúc mọi người một ngày tốt lanh ạ .
^^^^

Nhiệt tình đăng cấp là cảm giác đầu tiền em cảm nhận dc từ diễn đàn.
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,976
Được thích
13,611
Điểm
1,560
Em không hiểu sao lại phải lấy là 2 ký tự hả anh.Nếu có trường hợp 2 ký tự cuối giống nhau thì sao.
Thì mình nhìn các dữ liệu và chọn 2, Nếu dữ liệu khác phải xử lý khác, tổng quát sẽ thêm ký tự để các giá trị có len bằng nhau
 
Top Bottom