处理string的字符限制
单元格可以包含大量的字符。 我不确定的限制，但我正在testing450 +字符。 在VBA中，我没有任何问题插入一个string中的单元格的值，阅读它通过debug.print，使用函数如Len（str）为了find字符数。
我的问题
我想要玩的string是HTMLstring，我在其上应用格式，然后删除HTML标记。 这些格式应用没有问题，使用一个macros，我不认为是必要显示（很长），但是当时间去除HTML标签，当string高于255个字符时遇到问题。
重现它自己，看看
这里是一段代码，删除有关字体颜色的HTML标签，调整到使情况突出。 要使用它，请select一个包含HTML标签的单元格并运行代码。 BE CAREFUL – 当长度大于255个字符时，它将运行一个无限循环，因此，使用F8进行操作，并首次查看debug.prints。 删除只是简单地跳过，甚至没有出现任何错误。
Sub removeColorTags() Dim i As Integer Dim rng As Range Dim str As String Set rng = ActiveCell i = InStr(rng.Value, "<font") Do Until i = 0 Debug.Print Len(rng.Value) str = rng.Value Debug.Print str 'Displays correctly rng.Characters(i, 20).Delete i = InStr(rng.Value, "</font>") rng.Characters(i, 7).Delete i = InStr(rng.Value, "<font") Loop End Sub 这里是一个例子，你可以parsing一个单元格来试验代码，看看它的成功没有问题。 它将删除颜色标签，但保留大小标签。 确保你得到整个行（250个字符）
<font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font>
这里是一个例子，你可以parsing一个单元格来尝试代码，看看它失败。 确保你得到整个行（450个字符）
<font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font><font color=#8DB4E2><size=09>Action ligne 3</font>
我想要什么
我想要一个方法来删除长string的HTML标签。 这样做没有引用一个单元格（取一个string中的值，使用Replace或其他方式删除标签）不起作用，因为当把值放回去时，格式化会丢失。 整个过程就是格式化单元格。
这是我最终做的。 首先，让我们看看input，转换信息和输出的截图。 我从一个正常格式的Excel文本格式开始，然后将其转换为类似于（ 但不是很像 ）的HTML。 这个问题是问我如何从HTMlstring（截图的中间部分）删除子string（HTML标签），而不会丢失格式。
这是如何回答这个问题的
我需要一种方法来删除子string，而不会丢失具有超过255个字符的单元格格式。 这意味着不使用characters.insert或characters.delete ，因为正如蒂姆·威廉斯指出的那样，他们在255个字符之后引起问题。 因此，作为一种解决方法，我将要删除的子串之间的inputstring分段，logging它们的格式，将它们放回到一起，然后使用characters(x,y).font重新应用格式。
我将要显示的子扫描char字符的HTMLstring，并将其logging在一个临时string。 遇到HTML标记时，它将停止logging临时string，并将其与该临时string相关的格式一起logging在数组中。 然后它读取标签并将“当前格式”更改为HTML标签所做的操作，并以新的临时string重新开始录制。 我会承认，通过调用函数可以缩短子，但它可以工作。
Sub FromHTML(rngToConvert As Range) Dim i As Integer, j As Integer, k As Integer Dim strHTML As String, strTemp As String Dim rng As Range Dim arr() Dim lengthFormatted As Integer Dim optBold As Boolean, optIta As Boolean, optUnd As Boolean, optCol As String, optSize As Integer Dim inStrTemp As Boolean Dim nbChars As Integer Set rng = rngToConvert.Offset(0, 2) rng.Clear strHTML = rngToConvert.Value If InStr(strHTML, "<") = 0 Then Exit Sub ReDim arr(6, 0) inStrTemp = False strTemp = "" optBold = False optIta = False optUnd = False optCol = "0,0,0" optSize = "11" For i = 1 To Len(strHTML) If Not Mid(strHTML, i, 1) = "<" And Not Mid(strHTML, i, 4) = "[LF]" Then 'All WANTED characters go here strTemp = strTemp & Mid(strHTML, i, 1) inStrTemp = True If Len(strTemp) > 200 Or i = Len(strHTML) Then 'Cuts them shorter than 200 chars 'In retrospect this isn't necessary but doesn't interfere ReDim Preserve arr(6, j) arr(0, j) = strTemp arr(1, j) = optBold arr(2, j) = optIta arr(3, j) = optUnd arr(4, j) = optCol arr(5, j) = optSize arr(6, j) = Len(strTemp) strTemp = "" j = j + 1 End If ElseIf Mid(strHTML, i, 4) = "[LF]" Then '[LF] is what I used to indicate that there was a line change in the original text ReDim Preserve arr(6, j) arr(0, j) = strTemp arr(1, j) = optBold arr(2, j) = optIta arr(3, j) = optUnd arr(4, j) = optCol arr(5, j) = optSize arr(6, j) = Len(strTemp) strTemp = "" j = j + 1 strTemp = vbLf inStrTemp = True i = i + 3 ReDim Preserve arr(6, j) arr(0, j) = strTemp arr(1, j) = optBold arr(2, j) = optIta arr(3, j) = optUnd arr(4, j) = optCol arr(5, j) = optSize arr(6, j) = Len(strTemp) strTemp = "" j = j + 1 Else If inStrTemp = True Then 'Records the temporary string and the formats it used ReDim Preserve arr(6, j) arr(0, j) = strTemp arr(1, j) = optBold arr(2, j) = optIta arr(3, j) = optUnd arr(4, j) = optCol arr(5, j) = optSize arr(6, j) = Len(strTemp) strTemp = "" j = j + 1 inStrTemp = False End If 'If we get here we hit a HTML tag, so we read it and skip to after it If Mid(strHTML, i, 3) = "<b>" Then optBold = True i = i + 2 ElseIf Mid(strHTML, i, 4) = "</b>" Then optBold = False i = i + 3 ElseIf Mid(strHTML, i, 3) = "<i>" Then optIta = True i = i + 2 ElseIf Mid(strHTML, i, 4) = "</i>" Then optIta = False i = i + 3 ElseIf Mid(strHTML, i, 3) = "<u>" Then optUnd = True i = i + 2 ElseIf Mid(strHTML, i, 4) = "</u>" Then optUnd = False i = i + 3 ElseIf Mid(strHTML, i, 11) Like "<c=???????>" Then 'optCol = RED, GREEN, BLUE optCol = CInt("&H" & Mid(strHTML, i + 4, 2)) & "," & _ CInt("&H" & Mid(strHTML, i + 6, 2)) & "," & _ CInt("&H" & Mid(strHTML, i + 8, 2)) i = i + 10 ElseIf Mid(strHTML, i, 6) Like "<s=??>" Then optSize = CInt(Mid(strHTML, i + 3, 2)) i = i + 5 End If End If Next 'Filling the cell with unformatted text For i = 0 To UBound(arr, 2) 'This debug.print shows the tempString that was recorded and the associated formats Debug.Print arr(0, i) & " Bold=" & arr(1, i) & " Italic=" & arr(2, i) & " Underline=" & arr(3, i) & " RGB=" & arr(4, i) & " Size =" & arr(5, i) rng.Value = rng.Value + arr(0, i) Next 'Applying formats according to the arrays nbChars = 1 For i = 0 To UBound(arr, 2) If arr(0, i) = vbLf Then nbChars = nbChars + 1 Else rng.Characters(nbChars, arr(6, i)).Font.Bold = arr(1, i) rng.Characters(nbChars, arr(6, i)).Font.Italic = arr(2, i) rng.Characters(nbChars, arr(6, i)).Font.Underline = arr(3, i) rng.Characters(nbChars, arr(6, i)).Font.Color = RGB(Split(arr(4, i), ",")(0), Split(arr(4, i), ",")(1), Split(arr(4, i), ",")(2)) rng.Characters(nbChars, arr(6, i)).Font.Size = CInt(arr(5, i)) nbChars = nbChars + arr(6, i) End If Next End Sub
我觉得这个问题很复杂，我想回答这个问题的原因是因为它可以帮助任何人完成类似的目标。 当然，需要做一些调整。 这是我用来从格式化文本转换为HTML文本的function。 这不是问题的一部分，但将有助于理解标签。 这是基于我在网上find的function（虽然我不记得在哪里）。 如果你想同时使用这两个subs，那么一定要删除这个函数放入的HTMLstring的开头和结尾的<html>和</html>标签。
Function fnConvert2HTML(myCell As Range) As String Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn, sizTagOn As Boolean Dim i, chrCount As Integer Dim chrCol, chrLastCol, chrSiz, chrLastSiz, htmlTxt As String bldTagOn = False itlTagOn = False ulnTagOn = False colTagOn = False sizTagOn = False chrCol = "NONE" htmlTxt = "<html>" chrCount = myCell.Characters.Count For i = 1 To chrCount With myCell.Characters(i, 1) 'If (.Font.Color) Then chrCol = fnGetCol(.Font.Color) If chrCol <> chrLastCol Then htmlTxt = htmlTxt & "<c=#" & chrCol & ">" chrLastCol = chrCol End If 'End If If (.Font.Size) Then chrSiz = .Font.Size If Len(chrSiz) = 1 Then chrSiz = "0" & chrSiz If Not chrLastSiz = chrSiz Then htmlTxt = htmlTxt & "<s=" & chrSiz & ">" End If chrLastSiz = chrSiz End If If .Font.Bold = True Then If Not bldTagOn Then htmlTxt = htmlTxt & "<b>" bldTagOn = True End If Else If bldTagOn Then htmlTxt = htmlTxt & "</b>" bldTagOn = False End If End If If .Font.Italic = True Then If Not itlTagOn Then htmlTxt = htmlTxt & "<i>" itlTagOn = True End If Else If itlTagOn Then htmlTxt = htmlTxt & "</i>" itlTagOn = False End If End If If .Font.Underline > 0 Then If Not ulnTagOn Then htmlTxt = htmlTxt & "<u>" ulnTagOn = True End If Else If ulnTagOn Then htmlTxt = htmlTxt & "</u>" ulnTagOn = False End If End If If (Asc(.Text) = 10) Then htmlTxt = htmlTxt & "[LF]" Else htmlTxt = htmlTxt & .Text End If End With Next If bldTagOn Then htmlTxt = htmlTxt & "</b>" bldTagOn = False End If If itlTagOn Then htmlTxt = htmlTxt & "</i>" itlTagOn = False End If If ulnTagOn Then htmlTxt = htmlTxt & "</u>" ulnTagOn = False End If htmlTxt = htmlTxt & "</html>" fnConvert2HTML = htmlTxt End Function
你可以遍历单元格中的所有字符，检查你是不是在里面和HTML标签，并将文本添加到另一个单元格。 下面的代码将做到这一点（考虑从单元格A1input和输出到单元格A2，都在activesheet）：
Sub RemoveHtmlTags() Dim charaux As String Dim insideHTMLtag As Boolean insideHTMLtag = False For i = 1 To Len(ActiveSheet.Cells(1, 1).Value) charaux = Mid(ActiveSheet.Cells(1, 1).Value, i, 1) If (charaux = "<") Then insideHTMLtag = True ElseIf (charaux = ">") Then insideHTMLtag = False ElseIf (Not insideHTMLtag) Then ActiveSheet.Cells(2, 1).Value = ActiveSheet.Cells(2, 1).Value + Mid(ActiveSheet.Cells(1, 1).Value, i, 1) End If Next i End Sub
我已经testing了它在Excel 2016 for Mac上，它工作正常。