Dim dna As String, lengteDNA As Integer, codering As String, huidigeLetter As String, NextLetter As String, _
alfabet As String

dna = ActiveCell.Value
lengteDNA = Len(dna)
alfabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

'het resultaat is voorlopig leeg
codering = ""

'neem eerste letter
huidigeLetter = Left(dna, 1)
'zet het aantal op 1 (de eerste letter werd 1x ingelezen)
aantal = 1
'en ga naar plaats 2 en begin te loopen
For i = 2 To lengteDNA
   'lees de nieuwe letter in
   NextLetter = Mid(dna, i, 1)

   'is het dezelfde? of een andere?
   If NextLetter = huidigeLetter Then
      'bij dezelfde letter: gewoon aantal verhogen.. that's it
      aantal = aantal + 1
   Else
      'bij een nieuwe letter: de oude correct wegschrijven
      If aantal < 4 Then
      codering = huidigeLetter
          'loopje dat huidigeLetter 1, 2 of 3 maal wegschrijft naar codering
            For j = 1 To aantal
               codering = codering & huidigeLetter
            Next j
      Else
         'we hebben er meer dan 4... dat wordt coderen
         'zoek juiste alfabetletter
          If aantal <= 26 Then
              codering = codering & "-" & Mid(alfabet, aantal, 1) & huidigeLetter
          ElseIf aantal > 26 Then
              '' werkt enkel voor aantal kleiner dan 52 ... :-(
              aantal = aantal - 26
              codering = codering & "-" & "Z" & huidigeLetter & "-" & Mid(alfabet, aantal, 1) & huidigeLetter
          End If
      End If
      'zo, de huidige is weggeschreven... de nieuwe wordt de huidige
       huidigeLetter = NextLetter
       aantal = 1
   End If
Next i