As a start 
Function AddTags(ByVal oCell As Range) As String
Dim lngIndex As Long
Dim strResult As String
Dim bIsBold As Boolean, bIsItalic As Boolean

'Skip any Cells that don't need Tags
If oCell.Font.Regular Then
   AddTags = oCell.Value
   Exit Function
End if
.
.
.



Just for ideas, I'm pretty sure about Split and Join with the arrays. But the Character Properties has me flummoxed.
Function SamT(oCell As Range) As String
Dim arrLines '() 'As Excel.Characters
Dim arrWords '() 'As Excel.Characters
Dim cWord 'As Excel.Characters

'Check for singletons
If Not InStr(oCell.Text, Chr(10)) Then arrLines = oCell.Text
If Not InStr(oCell.Text, " ") Then cWord = oCell.Text

'Make some decisions
      
'is not a single line, is not a single word
arrLines = Split(oCell.Text, Chr(10))

'Loop thru all the lines
      For i = LBound(arrLines) To UBound(arrLines)
         arrWords = Split(arrLines(i), " ")
          For j = LBound(arrWords) To UBound(arrWords)
            cWord = arrWords(j)
CheckWord:
            If cWord.Font.FontStyle = Regular Then GoTo SkipWord
            'Else use your tag processing code
            'cWord = AddTags(cWord)
SkipWord:
            arrWords(j) = cWord
         Next j
         
         arrLines(i) = Join(arrWords, " ")
      Next i

   SamT = Join(arrLines, "</p>chr(10)<p>")
End Function