HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Translation function - one word set to another

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
functiononewordanothertranslationset

Problem

I have this Excel VBA function that takes three parameters. It is essentially a translation mechanism with the following parameters:

  • A sentence which has to be translated.



  • A range of words to look for and what to translate them to.



  • Shows in which column the translation is in the range (usually it's 2).



This function works perfect with small 'vocabulary', but when the range gets big and many translations occur, my file can become so difficult it loads in 15 minutes. I have no ideas how to make this code simpler because I'm new to VBA. Could anyone give me advice?

Function FindSubStringAndReplaceRange(sentence As String, range As range, selected As Integer)
    Dim position As Integer
    Dim searchableLength As Integer
    Dim newSentence As String
    Dim intASCII As Integer

    Dim searchable As String
    Dim replaceWith As String

    FindSubStringAndReplaceRange = sentence

    For Each i In range.Rows
        If IsEmpty(i.Cells(1, 1)) = False Then

            searchable = i.Cells(1, 1)

            If IsEmpty(i.Cells(1, selected)) = False Then
                replaceWith = i.Cells(1, selected)
            Else
                replaceWith = vbNullString
            End If

            searchableLength = Len(searchable)
            position = InStr(UCase(FindSubStringAndReplaceRange), UCase(searchable))
            If position <> 0 Then
                intASCII = Asc(Right$(Left$(FindSubStringAndReplaceRange, position), 1))

                If intASCII >= 65 And intASCII <= 90 Then
                    replaceWith = UCase(Left$(replaceWith, 1)) + Right$(replaceWith, Len(replaceWith) - 1)
                End If

                FindSubStringAndReplaceRange = Left$(FindSubStringAndReplaceRange, position - 1) + replaceWith + Right$(FindSubStringAndReplaceRange, Len(FindSubStringAndReplaceRange) - (position + searchableLength - 1))

            End If
         End If
    Next

End Function

Solution

Best approach

If your vocabulary library is very large you need to implement another data structure and sorting algorithm for your vocabulary. I would go with Bucket Sort. You need to partition your strings into separate buckets of characters
to optimize. Comparing entire strings is not efficient.
Alternative approach

If you are lazy or prefer a different approach, utilize Microsoft Query (ACE.OLEDB - SQL) which is much more efficient than any VBA code. Dump your vocabulary to a single worksheet and execute an SQL to find your matches like so (for each sentence separately):

-
Split string to tokens and dump it to another worksheet DumpedTokens

-
Execute a query like this:

Find all matches in the Vocab worksheet. Keep tokens that don't have translations:

SELECT Iif(Vocab.Word = NULL, Dumped.Token, Vocab.TranslatedWord) FROM [DumpedTokens$] as Dumped 
LEFT OUTER JOIN [VocabularySheet$] as Vocab 
ON UCase(Vocab.Word) = UCase(Dumped.Token)


  • Join the strings back into sentences



This will probably run a couple of seconds.

If you want you can use my SQL AddIn to Excel which makes it easier to write SQL queries in Excel: http://www.analystcave.com/excel-tools/excel-sql-add-in-free/

Code Snippets

SELECT Iif(Vocab.Word = NULL, Dumped.Token, Vocab.TranslatedWord) FROM [DumpedTokens$] as Dumped 
LEFT OUTER JOIN [VocabularySheet$] as Vocab 
ON UCase(Vocab.Word) = UCase(Dumped.Token)

Context

StackExchange Code Review Q#93218, answer score: 4

Revisions (0)

No revisions yet.