View Single Post
  #19  
Old April 15th, 2009, 03:34 AM posted to microsoft.public.excel.worksheet.functions
Bernie Deitrick
external usenet poster
 
Posts: 2,496
Default Macro for detect palindromes and repeats in letters/numbers string

Luciano,

I'm not clear on what you want - only those that appear more than once?
What do you want with the ABBA and the AABBAA and the BAAB, all of which
only appear once?

Bernie


"Luciano Paulino da Silva" wrote in message
...
Bernie,
It is possible that I have not explained very well. At this moment,
I`m needing a code that detect the repeats for a givem string instead
to detect palindromes. For example, the string AABBAABB has two
repeats (AA and BB), and they appear 2 times.
Do you understand it now?
Thanks in advance,
Luciano


On 14 abr, 21:16, "Bernie Deitrick" deitbe @ consumer dot org wrote:
Luciano,

Change the code to that given below to include the count of the number of
repeats, then select A2:B??? before entering =PALINDROMES(A1) using
Ctrl-Shift-Enter.

HTH,
Bernie
MS Excel MVP

Function Palindromes(strBig As String) As Variant
Dim FoundPals() As String
Dim PalCount As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim PalExists As Boolean

PalCount = 1
ReDim FoundPals(1 To 2, 1 To 2)
For i = 1 To Len(strBig) - 1
For j = 2 To Len(strBig) - i + 1
If isPal(Mid(strBig, i, j)) Then
If PalCount = 1 Then
FoundPals(1, 2) = Mid(strBig, i, j)
FoundPals(2, 2) = 1
PalCount = 2
Else
PalExists = False
For k = 2 To UBound(FoundPals, 2)
If FoundPals(1, k) = Mid(strBig, i, j) Then
PalExists = True
FoundPals(2, k) = FoundPals(2, k) + 1
End If
Next k
If Not PalExists Then
ReDim Preserve FoundPals(1 To 2, 1 To PalCount + 1)
FoundPals(1, PalCount + 1) = Mid(strBig, i, j)
FoundPals(2, PalCount + 1) = 1
PalCount = PalCount + 1
End If
End If
End If
Next j
Next i

FoundPals(1, 1) = "Palindromes found:"
FoundPals(2, 1) = PalCount - 1
Palindromes = Application.Transpose(FoundPals)

End Function
Function isPal(strPal As String) As Boolean
Dim i As Integer
Dim strTemp As String
isPal = False
For i = Len(strPal) To 1 Step -1
strTemp = strTemp & Mid(strPal, i, 1)
Next i
isPal = (strPal = strTemp)
End Function

"Luciano Paulino da Silva" wrote in
...
Bernie,
Yes, it is working fine. Thank you very much.
During some situations it is very slow, but I understand that there
are a lot of possibilities to test.
Do you know how some code could be used to check about repeats using
the same strategy?
Thanks in advance,
Luciano