Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
95 lines (72 sloc) 2.61 KB
Option Explicit
Sub Main()
Dim theWord As String: theWord = "kkbkannabannavannabb"
Dim length As Long: length = Len(theWord)
Dim maxLength As Long: maxLength = 1
Dim startAt As Long: startAt = 1
ClearTable
EditTheTable length
WriteTheWord theWord
ReDim matrix(length - 1, length - 1) As Long
'For 1:
Dim i As Long
For i = LBound(matrix) To UBound(matrix)
tblMatrix.Cells(i + 1, i + 1).Interior.Color = vbYellow
Next
'For 2:
For i = LBound(matrix) + 1 To UBound(matrix) - 1
If (Mid(theWord, i, 1) = Mid(theWord, i + 1, 1)) Then
maxLength = 2
startAt = i
tblMatrix.Cells(i, i + 1).Interior.Color = vbYellow
End If
Next
'For >2:
Dim k As Long
For k = 3 To length
Dim startingIndex As Long
For startingIndex = 1 To length - k + 1
Dim endingIndex As Long: endingIndex = startingIndex + k - 1
With tblMatrix
.Cells(length + 3, 1) = Mid(theWord, startingIndex, 1)
.Cells(length + 3, 2) = Mid(theWord, endingIndex, 1)
.Cells(length + 3, 1).Interior.Color = vbRed
.Cells(length + 3, 2).Interior.Color = vbRed
End With
tblMatrix.Cells(startingIndex, endingIndex).Select
If (tblMatrix.Cells(startingIndex + 1, endingIndex - 1).Interior.Color = vbYellow And _
Mid(theWord, startingIndex, 1) = Mid(theWord, endingIndex, 1)) Then
tblMatrix.Cells(startingIndex, endingIndex).Interior.Color = vbYellow
maxLength = k
startAt = startingIndex
End If
Next startingIndex
Next k
With tblMatrix
.Range(.Cells(length + 2, startAt), .Cells(length + 2, startAt + maxLength - 1)).Interior.Color = vbYellow
End With
End Sub
Sub EditTheTable(length As Long)
tblMatrix.Cells.Delete
Dim i As Long
For i = 1 To length
tblMatrix.Columns(i).ColumnWidth = 3.14
Next
End Sub
Sub ClearTable()
tblMatrix.Cells.Clear
End Sub
Sub WriteTheWord(theWord As String)
Dim row As Long
Dim col As Long
Dim sizeCounter As Long
For row = 1 To Len(theWord) + 2
If row <> Len(theWord) + 1 Then
For col = 1 To Len(theWord)
sizeCounter = sizeCounter + 1
tblMatrix.Cells(row, col) = Mid(theWord, sizeCounter, 1)
Next
End If
sizeCounter = 0
Next
End Sub
You can’t perform that action at this time.