Làm cách nào để thoát khỏi văn bản có định dạng trong excel?

Một số giải pháp ở đây yêu cầu tham chiếu đến Thư viện đối tượng MS Word. Chơi với những lá bài tôi được xử lý, tôi đã tìm ra giải pháp không phụ thuộc vào nó. Nó loại bỏ các thẻ RTF và các phần mềm khác như bảng phông chữ và biểu định kiểu, tất cả đều có trong VBA. Nó có thể hữu ích cho bạn. Tôi đã chạy nó trên dữ liệu của bạn và ngoài khoảng trắng, tôi nhận được kết quả giống như những gì bạn mong đợi

Đây là mã

Đầu tiên, một cái gì đó để kiểm tra xem một chuỗi có phải là chữ và số hay không. Cung cấp cho nó một chuỗi dài một ký tự. Chức năng này được sử dụng để tính toán phân định ở đây và ở đó

Public Function Alphanumeric(Character As String) As Boolean
   If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-", Character) Then
       Alphanumeric = True
   Else
       Alphanumeric = False
   End If
End Function

Tiếp theo là xóa toàn bộ nhóm. Tôi sử dụng cái này để xóa bảng phông chữ và các thứ rác rưởi khác

Public Function RemoveGroup(RTFString As String, GroupName As String) As String
    Dim I As Integer
    Dim J As Integer
    Dim Count As Integer

    I = InStr(RTFString, "{\" & GroupName)

    ' If the group was not found in the RTF string, then just return that string unchanged.
    If I = 0 Then
        RemoveGroup = RTFString
        Exit Function
    End If

    ' Otherwise, we will need to scan along, from the start of the group, until we find the end of the group.
    ' The group is delimited by { and }. Groups may be nested, so we need to count up if we encounter { and
    ' down if we encounter }. When that count reaches zero, then the end of the group has been found.
    J = I
    Do
        If Mid(RTFString, J, 1) = "{" Then Count = Count + 1
        If Mid(RTFString, J, 1) = "}" Then Count = Count - 1
        J = J + 1
    Loop While Count > 0

    RemoveGroup = Replace(RTFString, Mid(RTFString, I, J - I), "")

End Function

Được rồi, và chức năng này sẽ xóa mọi thẻ

Public Function RemoveTags(RTFString As String) As String
    Dim L As Long
    Dim R As Long
    L = 1
    ' Search to the end of the string.
    While L < Len(RTFString)
        ' Append anything that's not a tag to the return value.
        While Mid(RTFString, L, 1) <> "\" And L < Len(RTFString)
            RemoveTags = RemoveTags & Mid(RTFString, L, 1)
            L = L + 1
        Wend
    
        'Search to the end of the tag.
        R = L + 1
        While Alphanumeric(Mid(RTFString, R, 1)) And R < Len(RTFString)
            R = R + 1
        Wend
        L = R
    Wend
End Function

Chúng ta có thể loại bỏ các dấu ngoặc nhọn một cách rõ ràng

Public Function RemoveBraces(RTFString As String) As String
    RemoveBraces = Replace(RTFString, "{", "")
    RemoveBraces = Replace(RemoveBraces, "}", "")
End Function

Khi bạn đã sao chép các chức năng ở trên vào mô-đun của mình, bạn có thể tạo một chức năng sử dụng chúng để loại bỏ bất kỳ nội dung nào bạn không cần hoặc không muốn. Sau đây hoạt động hoàn hảo trong trường hợp của tôi

Public Function RemoveTheFluff(RTFString As String) As String
    RemoveTheFluff = Replace(RTFString, vbCrLf, "")
    RemoveTheFluff = RemoveGroup(RemoveTheFluff, "fonttbl")
    RemoveTheFluff = RemoveGroup(RemoveTheFluff, "colortbl")
    RemoveTheFluff = RemoveGroup(RemoveTheFluff, "stylesheet")
    RemoveTheFluff = RemoveTags(RemoveBraces(RemoveTheFluff))
End Function

Tôi hi vọng cái này giúp được. Tôi sẽ không sử dụng nó trong một trình xử lý văn bản hay bất cứ thứ gì, nhưng nó có thể giúp loại bỏ dữ liệu nếu đó là những gì bạn đang làm

Bạn có thể xóa tất cả định dạng khỏi các ô đã chọn bằng cách trước tiên chọn các ô mà bạn muốn xóa tất cả định dạng. Sau đó nhấp vào tab “Trang chủ” trong Dải băng. Sau đó nhấp vào nút “Xóa” trong nhóm nút “Chỉnh sửa”. Cuối cùng, chọn lệnh “Xóa định dạng” từ menu thả xuống xuất hiện. Sau đó, làm điều này sẽ xóa bất kỳ và tất cả định dạng ô được áp dụng trước đó khỏi các ô đã chọn. Sau đó, bạn có thể định dạng lại các ô đã chọn để sửa lỗi hiển thị giá trị ô của chúng, như mong muốn

Tôi có khoảng 12000 ô chứa đầy RTF trong Excel (bao gồm cả thẻ định dạng). Để truy cập nội dung chưa được định dạng, tôi phải phân tích chúng

Đây là ví dụ về một trong các ô có văn bản

{\rtf1\ansi\deflang1060\ftnbj\uc1
{\fonttbl{\f0 \froman \fcharset0 Times New Roman;}{\f1 \fswiss \fcharset238
Arial;}}
{\colortbl ;\red255\green255\blue255 ;\red0\green0\blue0 ;}
{\stylesheet{\fs24\cf2\cb1 Normal;}{\cs1\cf2\cb1 Default Paragraph Font;}}
\paperw11908\paperh16833\margl1800\margr1800\margt1440\margb1440\headery720\footery720
\deftab720\formshade\aendnotes\aftnnrlc\pgbrdrhead\pgbrdrfoot
\sectd\pgwsxn11908\pghsxn16833\marglsxn1800\margrsxn1800\margtsxn1440\margbsxn1440
\headery720\footery720\sbkpage\pgncont\pgndec
\plain\plain\f1\fs24\pard TPR 0160 000\par IPR 0160 000\par OB-R-02-28\par}

Và tất cả những gì tôi thực sự cần là cái này

TPR 0160 000
IPR 0160 000
OB-R-02-28

Vấn đề với việc chỉ cần lặp lại các ô để loại bỏ bất kỳ định dạng không liên quan nào là không phải tất cả 12000 ô đều dễ dàng như thế này. Kết quả là, tôi sẽ phải xem xét thủ công nhiều phiên bản và viết nhiều biến thể, và cuối cùng, vẫn còn rất nhiều công việc thủ công phải làm

Tuy nhiên, nếu tôi sao chép nội dung của một ô vào một tài liệu văn bản trống, lưu nó dưới dạng RTF, rồi mở nó trong MS Word, nó sẽ ngay lập tức phân tích cú pháp văn bản và cho tôi kết quả tôi cần. Thật không may, làm như vậy cho 12000 ô khá cồng kềnh

Do đó, tôi đã cân nhắc sử dụng macro VBA để sao chép đầu ra trở lại ô ban đầu sau khi sao chép nội dung của ô sang Word và buộc phân tích cú pháp. Đáng buồn thay, tôi không thực sự chắc chắn làm thế nào để làm điều đó

Có ai biết câu trả lời không?

Chức năng này sẽ hữu ích nếu bạn quyết định sử dụng Word để phân tích cú pháp văn bản. Bạn sẽ cần tham chiếu đến Thư viện đối tượng MS Word, như các nhận xét đề xuất

Function ParseRTF(strRTF As String) As String
Dim wdDoc As Word.Document 'Ref: Microsoft Word 11.0 Object Library'
Dim f     As Integer       'Variable to store the file I/O number'

'File path for a temporary .rtf file'
Const strFileTemp = "C:\TempFile_ParseRTF.rtf"

'Obtain the next valid file I/O number'
f = FreeFile

'Open the temp file and save the RTF string in it'
Open strFileTemp For Output As #f
    Print #f, strRTF
Close #f

'Open the .rtf file as a Word.Document'
Set wdDoc = GetObject(strFileTemp)

'Read the now parsed text from the Word.Document'
ParseRTF = wdDoc.Range.Text

'Delete the temporary .rtf file'
Kill strFileTemp

'Close the Word connection'
wdDoc.Close False
Set wdDoc = Nothing
End Function

Bạn có thể gọi nó cho từng ô trong số 12.000 ô của mình bằng cách sử dụng một cái gì đó tương tự như thế này

________số 8

Hàm ParseRTF mất khoảng một giây để chạy (ít nhất là trên máy của tôi), vì vậy đối với 12.000 ô, hàm này sẽ hoạt động trong khoảng ba tiếng rưỡi

Văn bản có định dạng trong Excel ở đâu?

Bạn có thể chỉnh sửa định dạng văn bản có định dạng không?