Hàm VBA Tìm chuỗi ký tự xuất hiện liền nhau dài nhất

[nvh611]

Kính mong các bạn trên diễn đàn giúp đỡ
Xin cảm ơn các bạn

 

[snow25]

Kính mong các bạn trên diễn đàn giúp đỡ
Xin cảm ơn các bạn

Đây nhé.

Function timkytu(ByVal dau As String, ByVal so As Integer, ByVal thu As Long, ParamArray mang()) As String
         Dim arr, s As String, i As Long, j As Long, T, a As Integer
         For Each T In mang
            If T.Count = 1 Then
               ReDim arr(1 To 1, 1 To 1): arr(1, 1) = T.Value
            Else
               arr = T.Value
            End If
            For j = 1 To UBound(arr, 2)
                a = 0
                For i = 1 To UBound(arr, 1)
                    If Len(arr(i, j)) = so Then
                       a = a + 1
                       If a = thu Then If s = Empty Then s = arr(i, j): Exit For Else s = s & dau & arr(i, j): Exit For
                    Else
                       a = 0
                    End If
                Next i
            Next j
        Next
        timkytu = s
End Function

=timkytu(";",3,2,C4:F7)

 

[nvh611]

Đây nhé.

Function timkytu(ByVal dau As String, ByVal so As Integer, ByVal thu As Long, ParamArray mang()) As String
         Dim arr, s As String, i As Long, j As Long, T, a As Integer
         For Each T In mang
            If T.Count = 1 Then
               ReDim arr(1 To 1, 1 To 1): arr(1, 1) = T.Value
            Else
               arr = T.Value
            End If
            For j = 1 To UBound(arr, 2)
                a = 0
                For i = 1 To UBound(arr, 1)
                    If Len(arr(i, j)) = so Then
                       a = a + 1
                       If a = thu Then If s = Empty Then s = arr(i, j): Exit For Else s = s & dau & arr(i, j): Exit For
                    Else
                       a = 0
                    End If
                Next i
            Next j
        Next
        timkytu = s
End Function

=timkytu(";",3,2,C4:F7)

Cảm ơn bạn @snow25 rất nhiều
Xây dựng được công thức như này cũng rất khó rồi
Nhưng bạn đang hiểu sai ý của mình
Mong bạn xem lại file và sửa giúp mình nhé
Cảm ơn bạn!

 

[concogia]

Kính mong các bạn trên diễn đàn giúp đỡ
Xin cảm ơn các bạn

Bài này chắc còn nhiều vấn đề để nói lắm. Cứ tạm thế này
Thân

Public Function Tim(Vung, DauPc, Kt, Xh)
    Dim I, J, iDem, Tam, Kq
    ReDim Kq(1 To Vung.Rows.Count * Vung.Columns.Count, 1 To 1)
        For I = 1 To Vung.Columns.Count
            iDem = 0: Tam = ""
            For J = 1 To Vung.Rows.Count
                If Len(Vung(J, I)) = Kt Then
                    iDem = iDem + 1
                    Tam = Vung(J, I)
                ElseIf Len(Vung(J, I)) <> Kt Then
                    If iDem > 0 Then
                        Kq(iDem, 1) = Kq(iDem, 1) & " " & Tam
                        iDem = 0
                    End If
                End If
                If J = Vung.Rows.Count Then
                    If iDem > 0 Then
                        Kq(iDem, 1) = Kq(iDem, 1) & " " & Tam
                        iDem = 0
                    End If
                End If
            Next J
        Next I
            For I = UBound(Kq) To 1 Step -1
                If Kq(I, 1) <> "" Then
                   iDem = iDem + 1
                   If iDem = Xh Then Tim = Kq(I, 1): Exit For
                End If
            Next I
    Tim = Replace(Trim(Tim), " ", DauPc)
End Function

 

[nvh611]

Bài này chắc còn nhiều vấn đề để nói lắm. Cứ tạm thế này
Thân

Public Function Tim(Vung, DauPc, Kt, Xh)
    Dim I, J, iDem, Tam, Kq
    ReDim Kq(1 To Vung.Rows.Count * Vung.Columns.Count, 1 To 1)
        For I = 1 To Vung.Columns.Count
            iDem = 0: Tam = ""
            For J = 1 To Vung.Rows.Count
                If Len(Vung(J, I)) = Kt Then
                    iDem = iDem + 1
                    Tam = Vung(J, I)
                ElseIf Len(Vung(J, I)) <> Kt Then
                    If iDem > 0 Then
                        Kq(iDem, 1) = Kq(iDem, 1) & " " & Tam
                        iDem = 0
                    End If
                End If
                If J = Vung.Rows.Count Then
                    If iDem > 0 Then
                        Kq(iDem, 1) = Kq(iDem, 1) & " " & Tam
                        iDem = 0
                    End If
                End If
            Next J
        Next I
            For I = UBound(Kq) To 1 Step -1
                If Kq(I, 1) <> "" Then
                   iDem = iDem + 1
                   If iDem = Xh Then Tim = Kq(I, 1): Exit For
                End If
            Next I
    Tim = Replace(Trim(Tim), " ", DauPc)
End Function

Bài này chắc còn nhiều vấn đề để nói lắm. Cứ tạm thế này
Thân

Public Function Tim(Vung, DauPc, Kt, Xh)
    Dim I, J, iDem, Tam, Kq
    ReDim Kq(1 To Vung.Rows.Count * Vung.Columns.Count, 1 To 1)
        For I = 1 To Vung.Columns.Count
            iDem = 0: Tam = ""
            For J = 1 To Vung.Rows.Count
                If Len(Vung(J, I)) = Kt Then
                    iDem = iDem + 1
                    Tam = Vung(J, I)
                ElseIf Len(Vung(J, I)) <> Kt Then
                    If iDem > 0 Then
                        Kq(iDem, 1) = Kq(iDem, 1) & " " & Tam
                        iDem = 0
                    End If
                End If
                If J = Vung.Rows.Count Then
                    If iDem > 0 Then
                        Kq(iDem, 1) = Kq(iDem, 1) & " " & Tam
                        iDem = 0
                    End If
                End If
            Next J
        Next I
            For I = UBound(Kq) To 1 Step -1
                If Kq(I, 1) <> "" Then
                   iDem = iDem + 1
                   If iDem = Xh Then Tim = Kq(I, 1): Exit For
                End If
            Next I
    Tim = Replace(Trim(Tim), " ", DauPc)
End Function

Cảm ơn bạn @concogia rất đúng bạn ơi
Đúng như bạn nói hàm này cần nhiều vấn đề
Nhưng như này là ổn rồi
Lần nữa cảm ơn bạn và chúc bạn luôn thành đạt nhé