Estoy obligado a extraer pasajes de texto del contenido de las celdas de Excel en las que el creador esencialmente ha realizado un seguimiento manual de cambios utilizando la fuente Tachado. Los pasajes son identificables con ciertos patrones de caracteres, pero tengo que ignorar los caracteres Tachados para verlos. Los caracteres tachados no aparecen en ubicaciones regulares dentro de cada celda, por lo que están esencialmente dispersos aleatoriamente con texto de fuente normal.

He logrado mi objetivo usando VBA para Excel, pero la solución es extremadamente lenta (e impracticable). Después de buscar respuestas en este sitio y en la web en general, parece que el uso del objeto Characters es el culpable.

Entonces mi pregunta es: ¿alguien ha encontrado una manera de analizar dicho texto que no involucre el objeto Characters?

El sub que escribí para hacer el análisis es demasiado largo para publicarlo aquí, pero a continuación hay un código de prueba que usa el objeto Characters de manera similar. Esto toma 60 s para analizar una celda con 3000 caracteres. A esa velocidad, tomaría 50 horas procesar la hoja de cálculo completa que me han dado.

Private Sub FindLineBreakChars(TargetCell As Excel.Range)

Dim n As Integer
Dim ch As String
Dim st As Boolean

If TargetCell.Cells.Count <> 1 Then
    Call MsgBox("Error: more or less than one cell in range specified.")
Else
    If IsEmpty(TargetCell.Value) Then
        Call MsgBox("Error: target cell is empty.")
    Else
        If Len(TargetCell.Value) = 0 Then
             Call MsgBox("Error: target cell contains an empty string.")
        Else
            'Parse the characters in the cell one by one.
            For n = 1 To TargetCell.Characters.Count
                ch = TargetCell.Characters(n, 1).Text
                st = TargetCell.Characters(n, 1).Font.Strikethrough
                If ch = vbCr Then
                    Debug.Print "#" & n & ": Carriage Return (vbCr)" & ", strikethrough = " & st & vbCrLf
                ElseIf ch = vbLf Then
                    Debug.Print "#" & n & ": Line Feed (vbLf)" & ", strikethrough = " & st & vbCrLf
                End If
            Next n
        End If
    End If
End If

End Sub
1
Grevillea2020 7 may. 2020 a las 12:16

2 respuestas

La mejor respuesta

Esto podría satisfacer sus necesidades de rendimiento: llama a una función que analiza la representación XML del contenido de la celda, elimina las secciones tachadas y devuelve el texto restante.

Será mucho más rápido que hacer un bucle sobre Characters

Sub Tester()

    Debug.Print NoStrikeThrough(Range("A1"))

End Sub

'Needs a reference to Microsoft XML, v6.0
'  in your VBA Project references
Function NoStrikeThrough(c As Range) '
    Dim doc As New MSXML2.DOMDocument60, rv As String
    Dim x As MSXML2.IXMLDOMNode, s As MSXML2.IXMLDOMNode
    'need to add some namespaces
    doc.SetProperty "SelectionNamespaces", _
                    "xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet' " & _
                    "xmlns:ht='http://www.w3.org/TR/REC-html40'"
    doc.LoadXML c.Value(11) 'cell data as XML
    Set x = doc.SelectSingleNode("//ss:Data")'<< cell content
    Set s = x.SelectSingleNode("//ht:S")     '<< strikethrough
    Do While Not s Is Nothing
        Debug.Print "Struck:", s.Text
        x.RemoveChild s '<< remove struck section
        Set s = x.SelectSingleNode("//ht:S")
    Loop
    NoStrikeThrough = doc.Text
End Function

EDITAR: aquí hay otra manera de hacerlo, dividiendo el texto en "bloques" y verificando cada bloque para ver si tiene algún tachado. Cuánto más rápido sea esto que ir carácter por carácter puede depender del tamaño del bloque y la distribución del texto tachado en cada celda.

Function NoStrikeThrough2(c As Range)
    Const BLOCK As Long = 50
    Dim L As Long, i As Long, n As Long, pos As Long, x As Long
    Dim rv As String, s As String, v

    L = Len(c.Value)
    n = Application.Ceiling(L / BLOCK, 1) 'how many blocks to check
    pos = 1                               'block start position
    For i = 1 To n
        v = c.Characters(pos, BLOCK).Font.Strikethrough
        If IsNull(v) Then
            'if strikethough is "mixed" in this block - parse out
            '  character-by-character
            s = ""
            For x = pos To pos + BLOCK
                If Not c.Characters(x, 1).Font.Strikethrough Then
                    s = s & c.Characters(x, 1).Text
                End If
            Next x
            rv = rv & s
        ElseIf v = False Then
            'no strikethrough - take the whole block
            rv = rv & c.Characters(pos, BLOCK).Text
        End If
        pos = pos + BLOCK 'next block position.
    Next i
    NoStrikeThrough2 = rv
End Function

EDIT2: si necesita asegurarse de que todos los caracteres de nueva línea no estén tachados antes de procesar la celda,

Sub ClearParaStrikes(c As Range)
    Dim pos As Long
    pos = InStr(pos + 1, c.Value, vbLf)
    Do While pos > 0
        Debug.Print "vbLf at " & pos
        c.Characters(pos, 1).Font.Strikethrough = False
        pos = InStr(pos + 1, c.Value, vbLf)
    Loop
End Sub
0
Tim Williams 10 may. 2020 a las 07:30

Tienes razón, el acceso a Characters es muy lento, por lo que tu objetivo debería ser reducir su uso tanto como sea posible.

No entiendo los detalles de sus requisitos, pero el siguiente código debería darle una idea de cómo podría acelerar el código. Lee el contenido de una celda solo una vez, divide el texto en líneas separadas, calcula la posición de los caracteres de salto de línea y mira esa posición para el formato. Hasta donde sé, no hay forma de acceder al formato de una vez, pero ahora el acceso al objeto characters se reduce a uno por línea:

With TargetCell 
    Dim lines() As String, lineNo As Integer, textLen As Long
    lines = Split(.Value2, vbLf)
    textLen = Len(lines(0)) + 1
    For lineNo = 1 To UBound(lines)
        Dim st
        st = .Characters(textLen, 1).Font.Strikethrough
        Debug.Print "#" & textLen & ": LineFeed (vbLf) strikethrough = " & st
        textLen = textLen + Len(lines(lineNo)) + 1
    Next lineNo
End With

Que yo sepa, Excel almacena Linebreaks en una celda usando solo el carácter LineFeed, por lo que el código solo verifica eso.

1
FunThomas 7 may. 2020 a las 11:06