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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)

File đính kèm

Ba Tê đã viết:
Nếu muốn kết quả sắp xếp từ 0-9 hoặc 9-0 thì sao?
Nhấp chuột vào đây để mở rộng...
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
 
VetMini đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bác ơi sao cháu dùng hàm của bác không ra được cái gì hở bác?
 
hongphuong1997 đã viết:
Em nhờ các bác đếm số tự nhiên như file đính kèm
Em xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Mã: 
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
 

File đính kèm

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
Nhấp chuột vào đây để mở rộng...
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?
Nhấp chuột vào đây để mở rộng...
 
HieuCD đã viết:
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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.
 
HieuCD đã viết:
Mã: 
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
Nhấp chuột vào đây để mở rộng...
Em dùng ArrayList để là bài này mà sao cái Reverse nó không đúng. Anh xem hộ em với ạ
Mã: 
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
 

File đính kèm

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
 
VetMini đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

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
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]
Nhấp chuột vào đây để mở rộng...
 

File đính kèm

hongphuong1997 đã viết:
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)
Nhấp chuột vào đây để mở rộng...
Đế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?
 
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 à
Nhấp chuột vào đây để mở rộng...
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 à
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn bác bác ơi chuẩn lắm rùi bác à
 
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
Nhấp chuột vào đây để mở rộng...
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.
 

File đính kèm

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.
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

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
Nhấp chuột vào đây để mở rộng...
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?
 
hongphuong1997 đã viết:
Bác ơi, bác
HieuCD
ơi
Bác giúp cháu với bác ơi
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

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
Nhấp chuột vào đây để mở rộng...
Bài đã được tự động gộp:

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
Nhấp chuột vào đây để mở rộng...
Siêu cao thủ quá bác ơi
Cháu cảm ơn bác
@HieuCD
 
@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???
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản." (2 người xem)
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
253
vietvanyen
V
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng (1 người xem)
Trả lời
12
Đọc
222
Phan Thế Hiệp
Phan Thế Hiệp
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel (1 người xem)
Trả lời
3
Đọc
57
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính (1 người xem)
Trả lời
16
Đọc
285
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
651
nguyendang95
N
T
Tìm số hóa đơn trong chuỗi (1 người xem)
Trả lời
8
Đọc
349
tranhungdao12a3
T
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
2
Đọc
130
Nga1852k
Nga1852k
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ
Trả lời
14
Đọc
1K
tung1423
tung1423
D
xin hỏi về lỗi mô đun ẩn.
Trả lời
3
Đọc
142
ongke0711
ongke0711
H
Xin anh chị hướng dẫn công thức excel ạ.
Trả lời
9
Đọc
280
Phan Thế Hiệp
Phan Thế Hiệp
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
381
Đọc
44K
tuanktt3
T
M
Add-in Excel kết nối cơ sở dữ liệu
Trả lời
1
Đọc
107
ptm0412
ptm0412
Đ
tách dữ liệu từ một dòng thành hai dòng (1 người xem)
Trả lời
2
Đọc
148
Phuocam
Phuocam
longhuy
Lỗi error 20728: F
Trả lời
0
Đọc
74
longhuy
longhuy
H
Trang tính chỉ hiển thị vùng có dữ liệu
Trả lời
7
Đọc
605
vinhkm6
vinhkm6
mrjun80
Có hàm nào đếm tổng các số nằm trong 1 ô không mọi người (1 người xem)
Trả lời
12
Đọc
495
Phan Thế Hiệp
Phan Thế Hiệp
N
Hàm DATEDIF trong Excel 2016 (1 người xem)
Trả lời
16
Đọc
14K
Phan Thế Hiệp
Phan Thế Hiệp
Tiger Nau
Đánh số thứ tự trên tờ vé số
Trả lời
6
Đọc
186
ptm0412
ptm0412
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom