Xin hàm đếm số tự nhiên trong một vùng (3 người xem)

hongphuong1997 · 30/11/18

HieuCD đã viết:
Đếm không loại trùng, có bao nhiêu thì đếm hết?
Trong vùng chỉ có số, không có ký tự chuỗi chen vào?

Bác ơi đếm không loại trùng bác à tức là có bao nhiêu số "0" thì đếm hết và các số khác cũng như vậy bác à

HieuCD · 30/11/18

hongphuong1997 đã viết:
Bác ơi đếm không loại trùng bác à tức là có bao nhiêu số "0" thì đếm hết và các số khác cũng như vậy bác à

Mã:

Function CountIf_Array(DieuKien As String, ParamArray Arr() As Variant) As Long
  'Dem 1 ký tu so, tu 0 -> 9
  If Len(DieuKien) <> 1 Or IsNumeric(DieuKien) = False Then Exit Function
  Dim i As Byte, iTem, j As Long, k As Long
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        For j = 1 To Len(iTem)
          If DieuKien = Mid(iTem, j, 1) Then k = k + 1
        Next j
      Next
    Else
      iTem = Arr(i)
      For j = 1 To Len(iTem)
        If DieuKien = Mid(iTem, j, 1) Then k = k + 1
      Next j
    End If
  Next i
  CountIf_Array = k
End Function

hongphuong1997 · 1/12/18

HieuCD đã viết:

Mã:

Function CountIf_Array(DieuKien As String, ParamArray Arr() As Variant) As Long
  'Dem 1 ký tu so, tu 0 -> 9
  If Len(DieuKien) <> 1 Or IsNumeric(DieuKien) = False Then Exit Function
  Dim i As Byte, iTem, j As Long, k As Long
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        For j = 1 To Len(iTem)
          If DieuKien = Mid(iTem, j, 1) Then k = k + 1
        Next j
      Next
    Else
      iTem = Arr(i)
      For j = 1 To Len(iTem)
        If DieuKien = Mid(iTem, j, 1) Then k = k + 1
      Next j
    End If
  Next i
  CountIf_Array = k
End Function

Cháu cảm ơn bác bác ơi chuẩn lắm rùi bác à

hongphuong1997 · 31/12/18

HieuCD đã viết:

Thêm phần thoát Function, do "bỏ tất cả các trứng vào chung 1 rổ" nên phải dùng Private Sub

Mã:

Function Count_Char(ResType As Integer, ParamArray Arr() As Variant)
  'ResType: Dang ket qua
  'ResType= -1 : Dem so ky tu cua chuoi so loai trung
  'ResType=  0 : Chuoi so loai trung khong Sort
  'ResType=  1 : Chuoi so loai trung Sort tu 0 -> 9
  'ResType=  2 : Chuoi so loai trung Sort tu 9 -> 0
  Dim i As Byte, iTem, S(0 To 9), Scheck(0 To 10)
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        Call Update_S(ResType, iTem, S, Scheck)
      Next
    Else
      Call Update_S(ResType, Arr(i), S, Scheck)
    End If
    If Scheck(10) = 10 Then Exit For
  Next i
  If ResType = -1 Then
    Count_Char = Scheck(10)
  Else
    Count_Char = Join(S, Empty)
  End If
End Function

Private Sub Update_S(ByVal ResType As Integer, ByVal iTem, ByRef S(), ByRef Scheck())
  Dim i As Long, ik As Byte, tmp As String
  For i = 1 To Len(iTem)
    tmp = Mid(iTem, i, 1)
    If IsNumeric(tmp) Then
      ik = CByte(tmp)
      If IsEmpty(Scheck(ik)) Then
        If ResType = 0 Then
          S(Scheck(10)) = ik
        ElseIf ResType = 1 Then
          S(ik) = ik
        ElseIf ResType = 2 Then
          S(9 - ik) = ik
        End If
        Scheck(ik) = True
        Scheck(10) = Scheck(10) + 1
        If Scheck(10) = 10 Then Exit Sub
      End If
    End If
  Next i
End Sub

Cháu chào bác
HieuCD
Cháu chúc bác nghỉ tết vui vẻ bác nhé!
Bác ơi 1 hàm này làm được tất cả các vấn đề
Bác viết thêm giúp cháu là: " Liệt kê tất cả các số từ 0-9 không có mặt trong dãy số đó với bác nhé
Cháu cảm ơn bác.

HieuCD · 31/12/18

hongphuong1997 đã viết:
Cháu chào bác
HieuCD
Cháu chúc bác nghỉ tết vui vẻ bác nhé!
Bác ơi 1 hàm này làm được tất cả các vấn đề
Bác viết thêm giúp cháu là: " Liệt kê tất cả các số từ 0-9 không có mặt trong dãy số đó với bác nhé
Cháu cảm ơn bác.

Mã:

Function Count_Char(ResType As Integer, ParamArray Arr() As Variant)
  'ResType: Dang ket qua
  'ResType= -1 : Dem so ky tu cua chuoi so loai trung
  'ResType=  0 : Chuoi so loai trung khong Sort
  'ResType=  1 : Chuoi so loai trung Sort tu 0 -> 9
  'ResType=  2 : Chuoi so loai trung Sort tu 9 -> 0
  'ResType=  3 : Chuoi so Khong co trong Arr() Sort tu 0 -> 9
  Dim i As Byte, iTem, S(0 To 9), Scheck(0 To 10)
  If ResType = 3 Then
    For i = 0 To 9
      S(i) = i
    Next i
  End If
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        Call Update_S(ResType, iTem, S, Scheck)
      Next
    Else
      Call Update_S(ResType, Arr(i), S, Scheck)
    End If
    If Scheck(10) = 10 Then Exit For
  Next i
  If ResType = -1 Then
    Count_Char = Scheck(10)
  Else
    Count_Char = Join(S, Empty)
  End If
End Function

Private Sub Update_S(ByVal ResType As Integer, ByVal iTem, ByRef S(), ByRef Scheck())
  Dim i As Long, ik As Byte, tmp As String
  For i = 1 To Len(iTem)
    tmp = Mid(iTem, i, 1)
    If IsNumeric(tmp) Then
      ik = CByte(tmp)
      If IsEmpty(Scheck(ik)) Then
        If ResType = 0 Then
          S(Scheck(10)) = ik
        ElseIf ResType = 1 Then
          S(ik) = ik
        ElseIf ResType = 2 Then
          S(9 - ik) = ik
        ElseIf ResType = 3 Then
          S(ik) = Empty
        End If
        Scheck(ik) = True
        Scheck(10) = Scheck(10) + 1
        If Scheck(10) = 10 Then Exit Sub
      End If
    End If
  Next i
End Sub

hongphuong1997 · 31/12/18

HieuCD đã viết:

Mã:

Function Count_Char(ResType As Integer, ParamArray Arr() As Variant)
  'ResType: Dang ket qua
  'ResType= -1 : Dem so ky tu cua chuoi so loai trung
  'ResType=  0 : Chuoi so loai trung khong Sort
  'ResType=  1 : Chuoi so loai trung Sort tu 0 -> 9
  'ResType=  2 : Chuoi so loai trung Sort tu 9 -> 0
  'ResType=  3 : Chuoi so Khong co trong Arr() Sort tu 0 -> 9
  Dim i As Byte, iTem, S(0 To 9), Scheck(0 To 10)
  If ResType = 3 Then
    For i = 0 To 9
      S(i) = i
    Next i
  End If
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        Call Update_S(ResType, iTem, S, Scheck)
      Next
    Else
      Call Update_S(ResType, Arr(i), S, Scheck)
    End If
    If Scheck(10) = 10 Then Exit For
  Next i
  If ResType = -1 Then
    Count_Char = Scheck(10)
  Else
    Count_Char = Join(S, Empty)
  End If
End Function

Private Sub Update_S(ByVal ResType As Integer, ByVal iTem, ByRef S(), ByRef Scheck())
  Dim i As Long, ik As Byte, tmp As String
  For i = 1 To Len(iTem)
    tmp = Mid(iTem, i, 1)
    If IsNumeric(tmp) Then
      ik = CByte(tmp)
      If IsEmpty(Scheck(ik)) Then
        If ResType = 0 Then
          S(Scheck(10)) = ik
        ElseIf ResType = 1 Then
          S(ik) = ik
        ElseIf ResType = 2 Then
          S(9 - ik) = ik
        ElseIf ResType = 3 Then
          S(ik) = Empty
        End If
        Scheck(ik) = True
        Scheck(10) = Scheck(10) + 1
        If Scheck(10) = 10 Then Exit Sub
      End If
    End If
  Next i
End Sub

Bác
HieuCD
ơi chuản quá rồi bác à
cháu cảm ơn bác
á bác cho cháu hỏi là nếu hàm có nhiều chức năng như vậy thì tốc độ tính toán của hàm có bị chậm đi không hở bác?

HieuCD · 31/12/18

hongphuong1997 đã viết:
Bác
HieuCD
ơi chuản quá rồi bác à
cháu cảm ơn bác
á bác cho cháu hỏi là nếu hàm có nhiều chức năng như vậy thì tốc độ tính toán của hàm có bị chậm đi không hở bác?

Càng nhiều chức năng thì càng chậm, code nầy chậm hơn không đáng kể

hongphuong1997 · 31/12/18

HieuCD đã viết:
Càng nhiều chức năng thì càng chậm, code nầy chậm hơn không đáng kể

Cháu cảm ơn bác ạ
Cháu chúc bác Năm mới an lành và có nhiều niềm vui mới bác nhé

hongphuong1997 · 1/1/19

HieuCD đã viết:
Càng nhiều chức năng thì càng chậm, code nầy chậm hơn không đáng kể

Bác ơi, bác
HieuCD
ơi
Bác giúp cháu với bác ơi

HieuCD · 1/1/19

hongphuong1997 đã viết:
Bác ơi, bác
HieuCD
ơi
Bác giúp cháu với bác ơi

Mã:

Function Large_Char(ResType As Byte, ParamArray Arr() As Variant)
  'ResType: Thu tu tù lon toi nho cua so lan trung
  If ResType < 1 Or ResType > 10 Then Exit Function
  Dim i As Long, k As Byte, dMax As Long, tmp As String, id
  Dim S(0 To 9), XepHang(), iTem
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        tmp = tmp & iTem
      Next
    Else
      tmp = tmp & Arr(i)
    End If
  Next i
 
  For i = 1 To Len(tmp)
    id = Mid(tmp, i, 1)
    If IsNumeric(id) Then
      id = CByte(id)
      S(id) = S(id) + 1
      If dMax < S(id) Then dMax = S(id)
    End If
  Next i
 
  ReDim XepHang(1 To dMax)
  For i = 0 To 9
    If Len(S(i)) > 0 Then XepHang(S(i)) = XepHang(S(i)) & i
  Next i
 
  Large_Char = ""
  For i = dMax To 1 Step -1
    If Len(XepHang(i)) > 0 Then
      k = k + 1
      If ResType = k Then
        Large_Char = XepHang(i)
        Exit Function
      End If
    End If
  Next i
End Function

PacificPR · 1/1/19

Cháu chúc Bác @HieuCD sang năm mới gặp được em nào xin xin cho Bác mấy cái niềm vui mới ạ _+)(9

tam888 · 2/1/19

PacificPR đã viết:
Cháu chúc Bác @HieuCD sang năm mới gặp được em nào xin xin cho Bác mấy cái niềm vui mới ạ

Không hiểu, xinh như ảnh (hình) chăng?

hongphuong1997 · 2/1/19

HieuCD đã viết:

Mã:

Function Large_Char(ResType As Byte, ParamArray Arr() As Variant)
  'ResType: Thu tu tù lon toi nho cua so lan trung
  If ResType < 1 Or ResType > 10 Then Exit Function
  Dim i As Long, k As Byte, dMax As Long, tmp As String, id
  Dim S(0 To 9), XepHang(), iTem
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        tmp = tmp & iTem
      Next
    Else
      tmp = tmp & Arr(i)
    End If
  Next i

  For i = 1 To Len(tmp)
    id = Mid(tmp, i, 1)
    If IsNumeric(id) Then
      id = CByte(id)
      S(id) = S(id) + 1
      If dMax < S(id) Then dMax = S(id)
    End If
  Next i

  ReDim XepHang(1 To dMax)
  For i = 0 To 9
    If Len(S(i)) > 0 Then XepHang(S(i)) = XepHang(S(i)) & i
  Next i

  Large_Char = ""
  For i = dMax To 1 Step -1
    If Len(XepHang(i)) > 0 Then
      k = k + 1
      If ResType = k Then
        Large_Char = XepHang(i)
        Exit Function
      End If
    End If
  Next i
End Function

[/QU
Siêu cao thủ quá bác ơi
Cháu cảm ơn bác

HieuCD

Bài đã được tự động gộp: 2/1/19

HieuCD đã viết:

Mã:

Function Large_Char(ResType As Byte, ParamArray Arr() As Variant)
  'ResType: Thu tu tù lon toi nho cua so lan trung
  If ResType < 1 Or ResType > 10 Then Exit Function
  Dim i As Long, k As Byte, dMax As Long, tmp As String, id
  Dim S(0 To 9), XepHang(), iTem
  For i = LBound(Arr) To UBound(Arr)
    If TypeName(Arr(i)) = "Range" Or TypeName(Arr(i)) = "Variant()" Then
      For Each iTem In Arr(i)
        tmp = tmp & iTem
      Next
    Else
      tmp = tmp & Arr(i)
    End If
  Next i

  For i = 1 To Len(tmp)
    id = Mid(tmp, i, 1)
    If IsNumeric(id) Then
      id = CByte(id)
      S(id) = S(id) + 1
      If dMax < S(id) Then dMax = S(id)
    End If
  Next i

  ReDim XepHang(1 To dMax)
  For i = 0 To 9
    If Len(S(i)) > 0 Then XepHang(S(i)) = XepHang(S(i)) & i
  Next i

  Large_Char = ""
  For i = dMax To 1 Step -1
    If Len(XepHang(i)) > 0 Then
      k = k + 1
      If ResType = k Then
        Large_Char = XepHang(i)
        Exit Function
      End If
    End If
  Next i
End Function

Siêu cao thủ quá bác ơi
Cháu cảm ơn bác
@HieuCD

tam888 · 2/1/19

@Chủ topic:

Không hiểu kiểu bài này ứng dụng vào đâu, giống toán cho học sinh lớp 3 quá, đang học các con số...

Hoặc là ứng dụng cho những người thích số đây???

Xin hàm đếm số tự nhiên trong một vùng (3 người xem)

Người dùng đang xem chủ đề này

hongphuong1997

Thành viên tiêu biểu

HieuCD

Chuyên gia GPE

File đính kèm

hongphuong1997

Thành viên tiêu biểu

hongphuong1997

Thành viên tiêu biểu

File đính kèm

HieuCD

Chuyên gia GPE

File đính kèm

hongphuong1997

Thành viên tiêu biểu

HieuCD

Chuyên gia GPE

hongphuong1997

Thành viên tiêu biểu

hongphuong1997

Thành viên tiêu biểu

File đính kèm

HieuCD

Chuyên gia GPE

File đính kèm

PacificPR

Thành viên mới

tam888

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

hongphuong1997

Thành viên tiêu biểu

tam888

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

Bài viết mới nhất

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

Đếm ngược thời gian