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

[hongphuong1997]

Em nhờ các bác đếm số tự nhiên như file đính kèm
Em xin cảm ơn

 

[♫ђöล♥ßล†♥†µ♫]

Em nhờ các bác đếm số tự nhiên như file đính kèm
Em xin cảm ơn

Bạn thử file xem có đúng yêu cầu không.

 

[Ba Tê]

Bạn thử file xem có đúng yêu cầu không.

Nếu muốn kết quả sắp xếp từ 0-9 hoặc 9-0 thì sao?

 

[♫ђöล♥ßล†♥†µ♫]

Nếu muốn kết quả sắp xếp từ 0-9 hoặc 9-0 thì sao?

Dạ. Chủ Topic chưa yêu cầu ạ. Em nghĩ muốn sắp xếp thì cho vòng lặp chạy từ 0 đến 9 hoặc ngược lại

 

[hongphuong1997]

Bạn thử file xem có đúng yêu cầu không.

Chuẩn quá rồi anh oi
Em cảm ơn anh
♫ђöล♥ßล†♥†µ♫

 

[VetMini]

Nếu muốn kết quả sắp xếp từ 0-9 hoặc 9-0 thì sao?

1. Viết 1 hàm nối chuỗi
2. Viết một hàm lấy chữ số từ 1 chuỗi
3. Hàm chính gọi hàm 2 và nạp tham vào hàm 1

i) Hàm 1 có nhiều code ở đây rồi. Chịu khó tìm

ii) Hàm 2

Function CacChuSo(ByVal s As String) As String
' hàm lấy ra các chữ số của một chuỗi
Dim i As Integer
For i = 0 To 9
If InStr(s, i) Then CacChuSo = CacChuSo & i
Next i
End Function

iii) hàm 3

Function LayChuSoTrongVung(vung As Range) As String
LayChuSoTrongVung = CacChuSo(ham1(vung))
' nếu muốn lấy số chữ số thì
' LayChuSoTrongVung = Len(CacChuSo(ham1(vung)))
End Function

 

[hongphuong1997]

1. Viết 1 hàm nối chuỗi
2. Viết một hàm lấy chữ số từ 1 chuỗi
3. Hàm chính gọi hàm 2 và nạp tham vào hàm 1

i) Hàm 1 có nhiều code ở đây rồi. Chịu khó tìm

ii) Hàm 2

Function CacChuSo(ByVal s As String) As String
' hàm lấy ra các chữ số của một chuỗi
Dim i As Integer
For i = 0 To 9
If InStr(s, i) Then CacChuSo = CacChuSo & i
Next i
End Function

iii) hàm 3

Function LayChuSoTrongVung(vung As Range) As String
LayChuSoTrongVung = CacChuSo(ham1(vung))
' nếu muốn lấy số chữ số thì
' LayChuSoTrongVung = Len(CacChuSo(ham1(vung)))
End Function

Bác ơi sao cháu dùng hàm của bác không ra được cái gì hở bác?

 

[concogia]

Nếu muốn kết quả sắp xếp từ 0-9 hoặc 9-0 thì sao?

Chạy 1 vòng trong vùng dữ liệu, nối dữ liệu
Chạy 1 vòng từ 0 ==> 9 hay ngược lại từ 9 ==> 0 lấy kết quả
Xong

 

[VetMini]

Bác ơi sao cháu dùng hàm của bác không ra được cái gì hở bác?

Cái hàm 1 của bạn đâu?

 

[HieuCD]

Em nhờ các bác đếm số tự nhiên như file đính kèm
Em xin cảm ơn

Function Count_Char(Choice As Long, ParamArray Arr() As Variant)
  Dim i As Byte, iTem, S(0 To 9)
  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 Sarray(iTem, S)
      Next
    Else
      Call Sarray(Arr(i), S)
    End If
  Next i
  tmp = Join(S, "")
  Count_Char = IIf(Choice = 2, tmp, Len(tmp))
End Function
Private Sub Sarray(ByVal iTem, ByRef S())
  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)
      S(ik) = ik
    End If
  Next i
End Sub

 

[SA_DQ]

Chạy 1 vòng trong vùng dữ liệu, nối dữ liệu
Chạy 1 vòng từ 0 ==> 9 hay ngược lại từ 9 ==> 0 lấy kết quả
Xong

Cũng có thể:
Vòng ngoài chạy từ 0 => 9 (hay 9 => 0)
Vòng trong chạy qua tất thẩy các ô của vùng;
Thấy kí số nào có thì ghi lại; Hết 2 vòng thì làm mồi nhậu!

Chấp luôn chuyện

Nếu muốn kết quả sắp xếp từ 0-9 hoặc 9-0 thì sao?

 

[VetMini]

Function Count_Char(Choice As Long, ParamArray Arr() As Variant)
...End Function
Private Sub Sarray(ByVal iTem, ByRef S())
  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)
      S(ik) = ik
    End If
  Next i
End Sub

Giải thuật này tốt nếu chuỗi ngắn. Chuỗi càng dài thì nó càng bất lợi.
Nếu bạn chuẩn bị dùng cho nhiều ranges thì nên thêm sửa sub Sarray thành hàm, trả về số chữ số. Khi số chữ số là 10 thì Count_Char thoát luôn, bởi vì nó không cần xét nữa.

 

[♫ђöล♥ßล†♥†µ♫]

Function Count_Char(Choice As Long, ParamArray Arr() As Variant)
  Dim i As Byte, iTem, S(0 To 9)
  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 Sarray(iTem, S)
      Next
    Else
      Call Sarray(Arr(i), S)
    End If
  Next i
  tmp = Join(S, "")
  Count_Char = IIf(Choice = 2, tmp, Len(tmp))
End Function
Private Sub Sarray(ByVal iTem, ByRef S())
  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)
      S(ik) = ik
    End If
  Next i
End Sub

Em dùng ArrayList để là bài này mà sao cái Reverse nó không đúng. Anh xem hộ em với ạ

Function CountJoinChar1(Choice As Long, ByVal tSort, ParamArray Args() As Variant)
    Dim Ndx As Long, Item, I As Long, Numb As Integer, Str As String
With CreateObject("System.Collections.ArrayList")
    For Ndx = LBound(Args) To UBound(Args)
        If TypeOf Args(Ndx) Is Range Then
            For Each Item In Args(Ndx)
                If Item <> Empty Then
                    If IsNumeric(Item) Then
                        If CLng(Item) = Int(Item) Then
                            For I = 1 To Len(Item)
                                Numb = Mid(Item, I, 1)
                                If Not .Contains(Numb) Then .Add Numb
                            Next I
                        End If
                    End If
                End If
            Next
        Else
            For I = 1 To Len(Args(Ndx))
                Numb = Mid(Args(Ndx), I, 1)
                If Not .Contains(Numb) Then .Add Numb
            Next I
        End If
    Next
    If IsMissing(tSort) Then GoTo Tiep  ' Khong sap xep
    If tSort = 1 Then 'tSort = 1: sap xep tang dan nguoc lai sap xep giam dan
        .Sort
    Else
        .Reverse
    End If
Tiep:
    If .Count Then
        Str = Join(.ToArray, vbNullString)
    End If
End With
CountJoinChar1 = IIf(Choice = 1, Len(Str), Str)
End Function

 

[VetMini]

Chưa sort thì làm sao ra đúng được.

If Not IsMissing(tSort) Then ' sap xep
.Sort
If tSort <> 1 Then . Reverse 'tSort = 1: sap xep tang dan nguoc lai sap xep giam dan
End If

 

[♫ђöล♥ßล†♥†µ♫]

Chưa sort thì làm sao ra đúng được.

If Not IsMissing(tSort) Then ' sap xep
.Sort
If tSort <> 1 Then . Reverse 'tSort = 1: sap xep tang dan nguoc lai sap xep giam dan
End If

Dạ. Hóa ra Reverse là chỉ đảo ngược lại thôi ạ

 

[HieuCD]

Giải thuật này tốt nếu chuỗi ngắn. Chuỗi càng dài thì nó càng bất lợi.
Nếu bạn chuẩn bị dùng cho nhiều ranges thì nên thêm sửa sub Sarray thành hàm, trả về số chữ số. Khi số chữ số là 10 thì Count_Char thoát luôn, bởi vì nó không cần xét nữa.

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

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

 

[hongphuong1997]

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

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
Bác        
                                                                                                     
           [B][USER=373036]HieuCD[/USER] ơi công thức của bác quá chuẩn làm được hết các trường hợp
Nhân thể chủ đề này bác viết giúp cháu là đếm luôn các số có mặt như file này với bác nhé
Cháu cảm ơn bác
[B]Bác        
                                                                                                     
           HieuCD ơi công thức của bác quá chuẩn làm được hết các trường hợp
Nhân thể chủ đề này bác viết giúp cháu là đếm luôn các số có mặt như file này với bác nhé
Cháu cảm ơn bác.[/B]

 

[HieuCD]

Đúng ý chưa?

 

[hongphuong1997]

Đúng ý chưa?

Bác ơi cháu cảm ơn bác
Nhưng không phải như vậy bác à
Ý của cháu là đếm tổng cộng có bao nhiêu số chữ số trong các vùng đó
(Giống như hàm COUNTIF đó bác)

 

[HieuCD]

Bác ơi cháu cảm ơn bác
Nhưng không phải như vậy bác à
Ý của cháu là đếm tổng cộng có bao nhiêu số chữ số trong các vùng đó
(Giống như hàm COUNTIF đó bác)

Đế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?