Tốt đẹp! Rất lắt léo.
Tôi đã thất vọng vì Excel không cho phép chúng tôi dán vào một ô được hợp nhất và cũng dán kết quả có chứa sự phá vỡ thành các hàng liên tiếp bên dưới ô "mục tiêu", vì điều đó có nghĩa là nó đơn giản là không hiệu quả với tôi. Tôi đã thử một vài điều chỉnh [unmerge/remerge, v.v.] nhưng sau đó Excel đã bỏ bất cứ thứ gì dưới một giờ nghỉ, vì vậy đó là một ngõ cụt.
Cuối cùng, tôi đã đưa ra một thói quen sẽ xử lý các thẻ đơn giản và không sử dụng bộ chuyển đổi Unicode "gốc" đang gây ra sự cố với các trường được hợp nhất. Hy vọng những người khác thấy điều này hữu ích:
Public Sub AddHTMLFormattedText[rngA As Range, strHTML As String, Optional blnShowBadHTMLWarning As Boolean = False]
' Adds converts text formatted with basic HTML tags to formatted text in an Excel cell
' NOTE: Font Sizes not handled perfectly per HTML standard, but I find this method more useful!
Dim strActualText As String, intSrcPos As Integer, intDestPos As Integer, intDestSrcEquiv[] As Integer
Dim varyTags As Variant, varTag As Variant, varEndTag As Variant, blnTagMatch As Boolean
Dim intCtr As Integer
Dim intStartPos As Integer, intEndPos As Integer, intActualStartPos As Integer, intActualEndPos As Integer
Dim intFontSizeStartPos As Integer, intFontSizeEndPos As Integer, intFontSize As Integer
varyTags = Array["", "", "", "", "", "", "", "", "", ""]
' Remove unhandled/unneeded tags, convert
and tags to line feeds
strHTML = Trim[strHTML]
strHTML = Replace[strHTML, "", ""]
strHTML = Replace[strHTML, "", ""]
strHTML = Replace[strHTML, "
", ""]
While LCase[Right$[strHTML, 4]] = "
" Or LCase[Right$[strHTML, 4]] = "
"
strHTML = Left$[strHTML, Len[strHTML] - 4]
strHTML = Trim[strHTML]
Wend
strHTML = Replace[strHTML, "
", vbLf]
strHTML = Replace[strHTML, "", vbLf]
strHTML = Trim[strHTML]
ReDim intDestSrcEquiv[1 To Len[strHTML]]
strActualText = ""
intSrcPos = 1
intDestPos = 1
Do While intSrcPos Len[strHTML] Then Exit Do
Exit For
End If
Next
If blnTagMatch = False Then
varTag = ""]
intSrcPos = intEndPos + 1
If intSrcPos > Len[strHTML] Then Exit Do
Else
varTag = ""
If LCase[Mid$[strHTML, intSrcPos, Len[varTag]]] = varTag Then
blnTagMatch = True
intSrcPos = intSrcPos + Len[varTag]
If intSrcPos > Len[strHTML] Then Exit Do
End If
End If
End If
If blnTagMatch = False Then
strActualText = strActualText & Mid$[strHTML, intSrcPos, 1]
intDestSrcEquiv[intSrcPos] = intDestPos
intDestPos = intDestPos + 1
intSrcPos = intSrcPos + 1
End If
Loop
' Clear any bold/underline/italic/superscript/subscript formatting from cell
rngA.Font.Bold = False
rngA.Font.Underline = False
rngA.Font.Italic = False
rngA.Font.Subscript = False
rngA.Font.Superscript = False
rngA.Value = strActualText
' Now start applying Formats!"
' Start with Font Size first
intSrcPos = 1
intDestPos = 1
Do While intSrcPos