Lấy số đếm của các chữ số

hongphuong · 20/9/22

Em chào các anh chị
Em nhờ các anh chị viết giúp hàm này với ạ
Em cảm ơn ạ

Bạn cần đăng nhập để thấy đa phương tiện

Yukino Ichikawa · 20/9/22

Bạn ơi, tại sao 55 = 1 mà 22 = 2, không hiểu gì hết á.

Cẩm Giang · 20/9/22

Yukino Ichikawa nói:
Bạn ơi, tại sao 55 = 1 mà 22 = 2, không hiểu gì hết á.

Ý bạn ấy là liệt kê số lần xuất hiện của 1 số đó. và 1 lần xuất hiện trong 3 dãy là những số nào. 2 lần là những số nào

Cẩm Giang · 20/9/22

@hongphuong

PHP:

Option Explicit


Function DemSo(sRng As Range) As String

    

    Dim iRng As Range

    Dim iString As String

    Dim i As Long

    Dim j As Long

    Dim A As Variant

    Dim Temp As Variant

    Dim Dict As Object

    Set Dict = CreateObject("Scripting.Dictionary")

    Dim iCheck As Long

    Dim iCount As Long

    

    ReDim Temp(0) As Variant

    iCheck = 0

    

    

    For Each iRng In sRng

        If iString = "" Then

            iString = iRng.Value

        Else

            iString = iString & "," & iRng.Value

        End If

    Next iRng

    

    A = Split(iString, ",")

    

    For i = LBound(A) To UBound(A)

        If i <> UBound(A) Then

            If Not Dict.Exists(A(i)) Then

                Dict.Add A(i), 1

                Temp(iCheck) = A(i)

                iCheck = iCheck + 1

                ReDim Preserve Temp(UBound(Temp) + 1) As Variant

            End If

        Else

            If Not Dict.Exists(A(i)) Then

                Temp(iCheck) = A(i)

            Else

                ReDim Preserve Temp(UBound(Temp) - 1) As Variant

            End If

        End If

    Next i

    

    For i = LBound(Temp) To UBound(Temp)

        For j = LBound(A) To UBound(A)

            If Temp(i) = A(j) Then

                iCount = iCount + 1

            End If

        Next j

        

        If DemSo = "" Then

            DemSo = "So " & Temp(i) & " - " & iCount & "lan"

        Else

            DemSo = DemSo & " ; So " & Temp(i) & " - " & iCount & "lan"

        End If

              

        iCount = 0

    Next i

End Function

hongphuong · 20/9/22

Em cảm ơn các anh @Yukino Ichikawa @Cẩm Giang anh viết chi tiết quá cơ
Nhưng em chỉ cần kết quả như hình ảnh này anh oi
Anh sửa giúp em với anh nhé

Bạn cần đăng nhập để thấy đa phương tiện

Binana · 21/9/22

hongphuong nói:
Em cảm ơn các anh @Yukino Ichikawa @Cẩm Giang anh viết chi tiết quá cơ
Nhưng em chỉ cần kết quả như hình ảnh này anh oi
Anh sửa giúp em với anh nhé

Hi vọng cái này đúng ý của bạn

Mã:

Function Dem(rng As Range) As Variant
    Dim Dic As Object, Dic2 As Object, Tmp, sArr, i&, S, So%, KQ, k&
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Dic2 = CreateObject("Scripting.Dictionary")
    sArr = Split(rng.Value, ",")
    For i = 0 To UBound(sArr)
        If sArr(i) <> Empty Then
            Dic.Item(sArr(i)) = Dic.Item(sArr(i)) & "#" & i
        End If
    Next
    For Each S In Dic.Keys
        Tmp = Split(Dic.Item(S), "#")
        So = UBound(Tmp)
        If So > 0 Then
            If Dic2.exists(So) = False Then
                Dic2.Add (So), ""
            End If
        End If
    Next
    ReDim KQ(1 To Dic2.Count, 1 To 1) As Variant
    For Each S In Dic2.Keys
        k = k + 1
        KQ(k, 1) = S
    Next
    Dem = KQ
End Function

hongphuong · 21/9/22

Cảm ơn anh @Binana hàm chưa đún anh oi
1- Là không chọn được cả vùng.
2- Là không có tham số.
Vì em là muốn lấy tất cả các số đếm của các số có mặt trong đó, vì vậy nếu không có tham số thì cũng chỉ lấy được 1 kết quả mà thoi.
=Dem($B$2:$B$4;Rows($1:1))
Em thì không biết gì về VBA nhưng hàm cho bài toán này thì bắt buộc phải có tham số thì mới lấy được hết kết quả.
Ví dụ hàm của anh @Cẩm Giang viết rất chi tiết chỉ cần sửa chút síu là được, nhưng em lại không biết cơ chứ.

Mã:

Option Explicit


Function DemSo(sRng As Range) As String

    

    Dim iRng As Range

    Dim iString As String

    Dim i As Long

    Dim j As Long

    Dim A As Variant

    Dim Temp As Variant

    Dim Dict As Object

    Set Dict = CreateObject("Scripting.Dictionary")

    Dim iCheck As Long

    Dim iCount As Long

    

    ReDim Temp(0) As Variant

    iCheck = 0

    

    

    For Each iRng In sRng

        If iString = "" Then

            iString = iRng.Value

        Else

            iString = iString & "," & iRng.Value

        End If

    Next iRng

    

    A = Split(iString, ",")

    

    For i = LBound(A) To UBound(A)

        If i <> UBound(A) Then

            If Not Dict.Exists(A(i)) Then

                Dict.Add A(i), 1

                Temp(iCheck) = A(i)

                iCheck = iCheck + 1

                ReDim Preserve Temp(UBound(Temp) + 1) As Variant

            End If

        Else

            If Not Dict.Exists(A(i)) Then

                Temp(iCheck) = A(i)

            Else

                ReDim Preserve Temp(UBound(Temp) - 1) As Variant

            End If

        End If

    Next i

    

    For i = LBound(Temp) To UBound(Temp)

        For j = LBound(A) To UBound(A)

            If Temp(i) = A(j) Then

                iCount = iCount + 1

            End If

        Next j

        

        If DemSo = "" Then

            'DemSo = "So " & Temp(i) & " - " & iCount & "lan"
DemSo = iCount & "lan"

        Else
'DemSo = DemSo & " ; So " & Temp(i) & " - " & iCount & "lan"

            DemSo = iCount & "lan"

        End If

              

        iCount = 0

    Next i

End Function

Binana · 21/9/22

Có lẽ do bạn mô tả ít thông tin quá. Toàn đoán mò để viết. Thôi chờ thành viên khác giúp coi sao

hongphuong · 21/9/22

Binana
Anh oi, như này anh nhé
Trong vùng dữ liệu có các số từ 00 đến 99
số nào đếm được bao nhiêu lần có mặt trong đó (Ví dụ số 88 đếm được 12 lần, thì chỉ lấy kết quả là số đếm của nó =12
chứ không phải là liệt kê hết các số ra)
Với điều kiện là các số đếm không lấy trùng.
Và liệt kê tất cả các số đếm ra (Không lấy trùng)

Noben · 21/9/22

hongphuong nói:
Nhưng em chỉ cần kết quả như hình ảnh này anh oi

Theo như trong hình ảnh của bạn (phần màu vàng) thì chỉ trả về kết quả sau khi tính. Như thế thì sau khi trả về kết quả thì làm sao biết được 1 số nào đó có kết quả là bao nhiêu.

hongphuong · 21/9/22

Anh @Noben Theo như code của anh @Cẩm Giang khi em sửa 1 chút thì kết quả gần đúng
Nhưng em muốn kết quả trả về theo từng dòng
(Nếu như dùng hàm của anh @Cẩm Giang kết quả trả về hàng ngang
Nhờ anh Cẩm Giang chỉnh sửa giúp em nếu trả về theo hàng ngang cũng được nhưng anh loại đi các số trùng giúp em với ạ (Và sắp xếp từ nhỏ đến lớn)
Em cảm ơn anh ạ.

Mã:

Function DemSo_2_3(sRng As Range) As String
    Dim iRng As Range
    Dim iString As String, i As Long, j As Long, A As Variant
    Dim Temp As Variant
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    Dim iCheck As Long
    Dim iCount As Long
    ReDim Temp(0) As Variant
    iCheck = 0
    For Each iRng In sRng
        If iString = "" Then
            iString = iRng.Value
        Else
            iString = iString & "," & iRng.Value
        End If
    Next iRng
    A = Split(iString, ",")
    For i = LBound(A) To UBound(A)
        If i <> UBound(A) Then
            If Not Dict.Exists(A(i)) Then
                Dict.Add A(i), 1
                Temp(iCheck) = A(i)
                iCheck = iCheck + 1
                ReDim Preserve Temp(UBound(Temp) + 1) As Variant
            End If
        Else
            If Not Dict.Exists(A(i)) Then
                Temp(iCheck) = A(i)
            Else
                ReDim Preserve Temp(UBound(Temp) - 1) As Variant
            End If
        End If
    Next i
    For i = LBound(Temp) To UBound(Temp)
        For j = LBound(A) To UBound(A)
            If Temp(i) = A(j) Then
                iCount = iCount + 1
            End If
        Next j
        If DemSo_2_3 = "" Then
            'DemSo_2_3 = "So " & Temp(i) & " - " & iCount & "lan"
DemSo_2_3 = DemSo_2_3 & iCount & ","

'DemSo_2_3 = iCount & "lan"
        Else
            'DemSo_2_3 = DemSo_2_3 & " ; So " & Temp(i) & " - " & iCount & "lan"
DemSo_2_3 = DemSo_2_3 & iCount & ","

'DemSo_2_3 = iCount & "lan"
        End If
        iCount = 0
    Next i
End Function

Cẩm Giang · 21/9/22

@hongphuong cho đề bài cụ thể, tham số sao, KQ sao đi

Noben · 21/9/22

Bạn kiểm tra thử nhé. Hàm trong Excel: =DemSo($B$2:$B$4;Rows(1:1))

Mã:

Function DemSo(sRng As Range, sohang As Integer)
    Dim iRng As Range
    Dim i As Long, R As Integer, Row As Integer, so As Integer
    Dim A As Variant, Arr(1 To 100, 1 To 2), dArr()
    Dim Dict As Object
    Dim iString As String

    Set Dict = CreateObject("Scripting.Dictionary")
   
    'Noi cac range thanh 1 chuoi duoc phan cach bang dau ","
    For Each iRng In sRng
        If iString = "" Then
            iString = iRng.Value
        Else
            iString = iString & "," & iRng.Value
        End If
    Next iRng

    A = Split(iString, ",")
   
    'Duyet qua tung so de dem so lan xuat hien cua tung so
    For i = LBound(A) To UBound(A)
        If Not Dict.Exists(A(i)) Then
            R = R + 1
            Dict.Add A(i), R
            Arr(R, 1) = A(i)
            Arr(R, 2) = Arr(R, 2) + 1
            If so < Arr(R, 2) Then so = Arr(R, 2)
        Else
            Row = Dict.Item(A(i))
            Arr(Row, 2) = Arr(Row, 2) + 1
            If so < Arr(Row, 2) Then so = Arr(Row, 2)
        End If
    Next i
   
    Dict.RemoveAll
    ReDim dArr(1 To so, 1 To 1)
   
    'Duyet lai so lan xuat hien cua cac so va gom cac so co lan xuat hien giong nhau
    R = 0
    For i = 1 To 100
        If Arr(i, 2) <> Empty Then
            If Not Dict.Exists(Arr(i, 2)) Then
                R = R + 1
                Dict.Add Arr(i, 2), R
                dArr(R, 1) = Arr(i, 2) & " : " & Arr(i, 1)
            Else
                Row = Dict.Item(Arr(i, 2))
                dArr(Row, 1) = dArr(Row, 1) & ", " & Arr(i, 1)
            End If
        End If
    Next i
    Set Dict = Nothing
    DemSo = dArr(sohang, 1)
   
End Function

tuhocvba · 21/9/22

Với yêu cầu chưa rõ ràng thì tôi khuyên các bạn nên bỏ qua, đỡ mất thời gian. Bản thân tôi rất nể không nỡ chuyển đi nơi khác vì thành viên này đã được nhắc nhở nhiều lần về cách trình bày thông tin rồi. Chả nhẽ lại cứ nhắc mãi.
Thời gian nên được sử dụng hiệu quả, không phải cứ code đã là tốt.

hongphuong · 21/9/22

Em cảm ơn anh @Noben ạ để em kiểm tra kết quả anh nhé.
Em cảm ơn anh rất nhiều ạ.
Anh @tuhocvba buồn cười ghê các anh ý dạy và làm giúp em tý tẹo mờ anh cứ cáu gắt nhặng lên.

hongphuong · 21/9/22

@Noben anh oi, em cảm ơn anh rất nhiều ạ. Nhưng kết quả chỉ đúng khi dữ liệu chỉ có vài dòng còn khi dữ liệu nhiều hơn một chút thì bị lỗi anh oi.
Anh xem lại giúp em với nhé anh!

Noben · 21/9/22

hongphuong nói:
khi dữ liệu nhiều hơn một chút thì bị lỗi

Lỗi là lỗi như thế nào, bạn không thể nói rõ hơn được à.

hongphuong · 21/9/22

@Noben anh oi
khi nhiều dữ liệu anh oi

Bạn cần đăng nhập để thấy đa phương tiện

Noben · 21/9/22

Noben nói:
DemSo = dArr(sohang, 1)

Bạn sửa chỗ này thành:

Mã:

    If sohang <= R Then
        DemSo = dArr(sohang, 1)
    Else
        DemSo = ""
    End If

hongphuong · 21/9/22

@Noben anh oi, càng bị lỗi anh oi

Lấy số đếm của các chữ số

Tôi yêu THVBA

VIP

Yêu THVBA

Yêu THVBA

Tôi yêu THVBA

VIP

Tôi yêu THVBA

VIP

Tôi yêu THVBA

Yêu THVBA

Tôi yêu THVBA

Yêu THVBA

Yêu THVBA

Administrator

Tôi yêu THVBA

Tôi yêu THVBA

Yêu THVBA

Tôi yêu THVBA

Yêu THVBA

Tôi yêu THVBA