Vba thay thế hàm Countifs.

kh0jy3n · 29/1/19

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 !

snow25 · 29/1/19

kh0jy3n đã viết:
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

FPT_online · 29/1/19

Bạn xem file nhé

snow25 · 29/1/19

kh0jy3n đã viết:
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: 29/1/19

FPT_online đã viết:
Bạn xem file nhé

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.

SA_DQ · 29/1/19

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 · 29/1/19

SA_DQ đã viết:

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.

batman1 · 29/1/19

snow25 đã viết:
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 làm chỉ cho đúng dữ liệu giả dụ ấy thôi. Nếu có C37, hay không chỉ C, hoặc C1, ..., C5, NK51, BT64 v...v thì tèo.

Viết code nên luôn coi dữ liệu chỉ là giả dụ.

tam888 · 29/1/19

batman1 đã viết:
Người ta làm chỉ cho đúng dữ liệu giả dụ ấy thôi. Nếu có C37, hay không chỉ C, hoặc C1, ..., C5, NK51, BT64 v...v thì tèo.

Viết code nên luôn coi dữ liệu chỉ là giả dụ.

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 · 29/1/19

tam888 đã viết:
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 nhìn A1..A9, C1..C5 tôi có cảm giác là dữ liệu giả lập, người hỏi lười soạn dữ liệu. Với dữ liệu kiểu đó tôi luôn cảnh giác, và cho là dữ liệu thực có thể rất khác.

FPT_online · 29/1/19

snow25 đã viết:
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.

Tại tôi không giỏi được như bạn nên tôi chỉ biết làm vậy thôi

snow25 · 29/1/19

FPT_online đã viết:
Tại tôi không giỏi được như bạn nên tôi chỉ biết làm vậy thôi

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 à.

HieuCD · 30/1/19

snow25 đã viết:

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

Kết quả lệch do công thức trong file sai

FPT_online · 30/1/19

snow25 đã viết:
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.

snow25 đã viết:
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ử lý code như nhau, mỗi người 1 cách viết khác nhau thôi, không biết bạn giỏi tới đâu mà tính toán như đúng rồi. Còn đi cười người khác nữa

SA_DQ · 30/1/19

batman1 đã viết:
Người ta làm chỉ cho đúng dữ liệu giả dụ ấy thôi. Nếu có C37, hay không chỉ C, hoặc C1, ..., C5, NK51, BT64 v...v thì tèo.
Viết code nên luôn coi dữ liệu chỉ là giả dụ.

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 · 30/1/19

FPT_online đã viết:
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ê · 30/1/19

kh0jy3n đã viết:
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.

HieuCD · 30/1/19

kh0jy3n đã viết:
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 · 30/1/19

HieuCD đã viết:

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 · 30/1/19

@@
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 · 30/1/19

snow25 đã viết:
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

Vba thay thế hàm Countifs.

Thành viên thường trực

File đính kèm

Thành viên gạo cội

Thành viên hoạt động

File đính kèm

Thành viên gạo cội

/(hông là gì!

Thành viên gạo cội

Thành viên gạo cội

Thành viên tích cực

Thành viên gạo cội

Thành viên hoạt động

Thành viên gạo cội

Chuyên gia GPE

Thành viên hoạt động

/(hông là gì!

Thành viên gạo cội

Cạo Rồi Khỏi Gội

File đính kèm

Chuyên gia GPE

Thành viên gạo cội

Thành viên thường trực

Chuyên gia GPE