Nhờ anh chị chỉnh hàm đếm theo điều kiện!!!

Liên hệ QC
nguyenanhdung8111982

nguyenanhdung8111982

Thành viên hoạt động
Tham gia
1/11/19
Bài viết
120
Được thích
33
Giới tính
Nam
em có code như dưới. em có sử dụng countif để đếm theo điều kiện bắt đầu là số 9.
Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*")
Nhưng trong cột có ô định dạng số không phải text nên không đếm được. em có thử dùng công thức này nhưng không biết viết trong vba sao cho chạy đúng.
Xy = Application.WorksheetFunction.SUMPRODUCT(--(LEFT("H2:F" & j,1)="9"))
Mã: 
Sub CountData()

Dim fso As Object, xlFile As Object

Dim sFolder$

Dim r&, j&
'On Error Resume Next
r = 1
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

Set fso = CreateObject("Scripting.FileSystemObject")

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.path

If .Show Then sFolder = fso.GetParentFolderName(.SelectedItems(1)) Else Exit Sub 'chon file

End With
For Each xlFile In fso.GetFolder(sFolder).Files
With Workbooks.Open(xlFile.path)

With .Sheets(1)

j = .Cells(.Rows.count, 1).End(xlUp).Row
CA = Application.WorksheetFunction.CountA(.Range("E2:E" & j)) 'tong hinh
SA = Application.WorksheetFunction.CountA(.Range("C2:C" & j)) 'dem o co du lieu cot sub

TA = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "?*") 'name
XX = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "Nhà ?") 'nha o
'Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "12*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "16*")
Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*")
ZA = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9385001")
XX1 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), " ")
XX2 = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), " ")
Xz = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9968017")
TA1 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "7328002") + Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "7397001")
xz5 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9968022") 'tru dien
xz2 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9932013") 'tru cuu hoa
xz3 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9942002") 'tram xe buyt
xz4 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9961023")
xz6 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9959032") + Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9959033")
xz7 = Application.WorksheetFunction.CountIf(.Range("A2:A" & j), "") + Application.WorksheetFunction.CountIf(.Range("A2:A" & j), "*")
xz8 = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*'*") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*'*") + Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*!*") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*!*") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*\") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*\*") + Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*\*") + Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*\")
'xz7 = Application.WorksheetFunction.CountIf(.Range("A2:A" & j), "*")
'xz7 = Application.WorksheetFunction.CountIfs(.Range("A2:A" & j), "", .Range("A2:A" & j), "<>" & "{0,1,2,3,4,5,6,7,8,9}")
'CountIf(.Range("A2:A" & j), "*"): text, special characters, blank
'CountIf(.Range("A2:A" & j), "?*"): text, special characters
'COUNTIF(A1:A11,”?*”) + SUMPRODUCT(–(ISLOGICAL(A1:A11))text, special characters, logical value
End With
.Close False
End With
r = r + 1
Cells(r, 1).Value = xlFile.Name
Cells(r, 2).Value = CA
Cells(r, 3).Value = SA
Cells(r, 4).Value = TA
Cells(r, 5).Value = ZA
Cells(r, 9).Value = XX
Cells(r, 10).Value = Xy 'sodthoai
Cells(r, 11).Value = XX1 'khoang cach cot code
Cells(r, 12).Value = XX2 ''khoang cach cot name
Cells(r, 13).Value = Xz 'sai ma duong
Cells(r, 14).Value = TA1 ' atm_ngan hang
Cells(r, 15).Value = xz5 'tru dien
Cells(r, 16).Value = xz2 'tru cuu hoa
Cells(r, 17).Value = xz3 'tram xe buyt
Cells(r, 18).Value = xz4 'den tin hieu
Cells(r, 19).Value = xz6
Cells(r, 20).Value = xz7
Cells(r, 21).Value = xz8
Next
MsgBox "Ho" & ChrW(224) & "n Th" & ChrW(224) & "nh !!!"
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True

End Sub
trân trọng
 

File đính kèm

  • dem.png
    dem.png
    236.1 KB · Đọc: 7
nguyenanhdung8111982 đã viết:
em có code như dưới. em có sử dụng countif để đếm theo điều kiện bắt đầu là số 9.
Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*")
Nhưng trong cột có ô định dạng số không phải text nên không đếm được. em có thử dùng công thức này nhưng không biết viết trong vba sao cho chạy đúng.
Xy = Application.WorksheetFunction.SUMPRODUCT(--(LEFT("H2:F" & j,1)="9"))
Mã: 
Sub CountData()

Dim fso As Object, xlFile As Object

Dim sFolder$

Dim r&, j&
'On Error Resume Next
r = 1
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

Set fso = CreateObject("Scripting.FileSystemObject")

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.path

If .Show Then sFolder = fso.GetParentFolderName(.SelectedItems(1)) Else Exit Sub 'chon file

End With
For Each xlFile In fso.GetFolder(sFolder).Files
With Workbooks.Open(xlFile.path)

With .Sheets(1)

j = .Cells(.Rows.count, 1).End(xlUp).Row
CA = Application.WorksheetFunction.CountA(.Range("E2:E" & j)) 'tong hinh
SA = Application.WorksheetFunction.CountA(.Range("C2:C" & j)) 'dem o co du lieu cot sub

TA = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "?*") 'name
XX = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "Nhà ?") 'nha o
'Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "12*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "16*")
Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*")
ZA = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9385001")
XX1 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), " ")
XX2 = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), " ")
Xz = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9968017")
TA1 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "7328002") + Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "7397001")
xz5 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9968022") 'tru dien
xz2 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9932013") 'tru cuu hoa
xz3 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9942002") 'tram xe buyt
xz4 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9961023")
xz6 = Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9959032") + Application.WorksheetFunction.CountIf(.Range("C2:C" & j), "9959033")
xz7 = Application.WorksheetFunction.CountIf(.Range("A2:A" & j), "") + Application.WorksheetFunction.CountIf(.Range("A2:A" & j), "*")
xz8 = Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*'*") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*'*") + Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*!*") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*!*") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*\") + Application.WorksheetFunction.CountIf(.Range("J2:J" & j), "*\*") + Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*\*") + Application.WorksheetFunction.CountIf(.Range("F2:F" & j), "*\")
'xz7 = Application.WorksheetFunction.CountIf(.Range("A2:A" & j), "*")
'xz7 = Application.WorksheetFunction.CountIfs(.Range("A2:A" & j), "", .Range("A2:A" & j), "<>" & "{0,1,2,3,4,5,6,7,8,9}")
'CountIf(.Range("A2:A" & j), "*"): text, special characters, blank
'CountIf(.Range("A2:A" & j), "?*"): text, special characters
'COUNTIF(A1:A11,”?*”) + SUMPRODUCT(–(ISLOGICAL(A1:A11))text, special characters, logical value
End With
.Close False
End With
r = r + 1
Cells(r, 1).Value = xlFile.Name
Cells(r, 2).Value = CA
Cells(r, 3).Value = SA
Cells(r, 4).Value = TA
Cells(r, 5).Value = ZA
Cells(r, 9).Value = XX
Cells(r, 10).Value = Xy 'sodthoai
Cells(r, 11).Value = XX1 'khoang cach cot code
Cells(r, 12).Value = XX2 ''khoang cach cot name
Cells(r, 13).Value = Xz 'sai ma duong
Cells(r, 14).Value = TA1 ' atm_ngan hang
Cells(r, 15).Value = xz5 'tru dien
Cells(r, 16).Value = xz2 'tru cuu hoa
Cells(r, 17).Value = xz3 'tram xe buyt
Cells(r, 18).Value = xz4 'den tin hieu
Cells(r, 19).Value = xz6
Cells(r, 20).Value = xz7
Cells(r, 21).Value = xz8
Next
MsgBox "Ho" & ChrW(224) & "n Th" & ChrW(224) & "nh !!!"
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True

End Sub
trân trọng
Nhấp chuột vào đây để mở rộng...
Dùng hàm tự tạo
Copy code dán vào đầu module
Mã: 
Option Compare Text

Function strCountIf(ByVal Rng As Range, ByVal Criteria As Variant)
  Dim iCell As Range, Cri As Variant, TypeCri$, tmp&
  TypeCri = TypeName(Criteria)
  If TypeCri <> "Variant()" And TypeCri <> "Range" Then Criteria = Array(Criteria)
  For Each Cri In Criteria
    If Cri <> Empty Then
      Cri = CStr(Cri)
      For Each iCell In Rng
        If CStr(iCell.Value) Like Cri Then tmp = tmp + 1
      Next iCell
    End If
  Next Cri
  strCountIf = tmp
End Function
Thay thế các lệnh theo ví dụ
Mã: 
'Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*")
Xy = strCountIf(.Range("H2:H" & j), "9*")

'Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "12*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "16*")
Xy = strCountIf(.Range("H2:H" & j), Array("9*", "12*", "16*"))
 
HieuCD đã viết:
Dùng hàm tự tạo
Copy code dán vào đầu module
Mã: 
Option Compare Text

Function strCountIf(ByVal Rng As Range, ByVal Criteria As Variant)
  Dim iCell As Range, Cri As Variant, TypeCri$, tmp&
  TypeCri = TypeName(Criteria)
  If TypeCri <> "Variant()" And TypeCri <> "Range" Then Criteria = Array(Criteria)
  For Each Cri In Criteria
    If Cri <> Empty Then
      Cri = CStr(Cri)
      For Each iCell In Rng
        If CStr(iCell.Value) Like Cri Then tmp = tmp + 1
      Next iCell
    End If
  Next Cri
  strCountIf = tmp
End Function
Thay thế các lệnh theo ví dụ
Mã: 
'Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*")
Xy = strCountIf(.Range("H2:H" & j), "9*")

'Xy = Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "9*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "12*") + Application.WorksheetFunction.CountIf(.Range("H2:H" & j), "16*")
Xy = strCountIf(.Range("H2:H" & j), Array("9*", "12*", "16*"))
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn HieuCD rất nhiều!!! Chúc bạn cuối tuần vui vẻ!!!
Trân trọng,
Nguyen Anh Dung
 
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

T
Exemplary Сasual Dating - Actual Women
Trả lời
0
Đọc
1
thanhdao91
T
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
Trả lời
13
Đọc
179
LuuAnh980
LuuAnh980
B
  • Question
Chuyển đổi dữ liệu sạng dạng mảng
Trả lời
5
Đọc
89
ongke0711
ongke0711
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
6
Đọc
142
Hoàng Tuấn 868
H
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
0
Đọc
63
shnhatha221108
S
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