Reading LBR (xml) as TXT in Excel vba

问题

I'm trying to read a .LBR extension file (XML language) in Excel with this code:

Dim X As Double
Dim TXT As String
Open "C:\Users\Asus\Desktop\Test\OJE-SS-124HM_000.lbr" For Input As #1
X = 1
Do While Not EOF(1)
Line Input #1, TXT
Worksheets("LBR").Cells(X, 1) = TXT
X = X + 1
Loop
Close #1

But I'm getting the entire text just in the first cell A1, see the bottom image. I'd like to get each text lines in separate cells, A1, A2, etc. What am I doing wrong?

I think the LBR file doesn't have a break line chr(13).

This is my preferred result: I'd like something like this

This is my actual result: But, I'm getting this

回答1:

I think this is what you want.

Sub SplitCellsBaseLineBreak()
    Dim str() As String
    Dim myRng As Range
    Set myRng = Application.Selection
    Set myRng = Application.InputBox("select one range that you want to split", "SplitCellsBaseLineBreak", myRng.Address, Type:=8)

    For Each myCell In myRng
        If Len(myCell) Then
            str = VBA.Split(myCell, vbLf)
            myCell.Resize(1, UBound(str) + 1).Offset(0, 1) = str
        End If
    Next
End Sub

回答2:

Oh, I see now. Ok, based on that image, try this.

Before:

After:

Option #1

Const ANALYSIS_ROW As String = "C"
Const DATA_START_ROW As Long = 1

Sub ReplicateData()
    Dim iRow As Long
    Dim lastrow As Long
    Dim ws As Worksheet
    Dim iSplit() As String
    Dim iIndex As Long
    Dim iSize As Long

    'Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook
        .Worksheets("Sheet2").Copy After:=.Worksheets("Sheet2")
        Set ws = ActiveSheet
    End With

    With ws
        lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row
    End With


    For iRow = lastrow To DATA_START_ROW Step -1
        iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ">")
        iSize = UBound(iSplit) - LBound(iSplit) + 1
        If iSize = 1 Then GoTo Continue

        ws.Rows(iRow).Copy
        ws.Rows(iRow).Resize(iSize - 1).Insert
        For iIndex = LBound(iSplit) To UBound(iSplit)
            ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex)
        Next iIndex
Continue:
    Next iRow

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    'Application.ScreenUpdating = True
End Sub

Option #2 Sub TryThis()

Dim lastrow As Integer
Dim i As Integer
Dim descriptions() As String

With ThisWorkbook
    .Worksheets("Sheet2").Copy After:=.Worksheets("Sheet2")
    Set ws = ActiveSheet
End With

With ActiveSheet
    lastrow = .Range("C1").End(xlDown).Row
    For i = lastrow To 2 Step -1
        If InStr(1, .Range("C" & i).Value, ">") <> 0 Then
            descriptions = Split(.Range("C" & i).Value, ">")
        End If
        For Each Item In descriptions
            .Range("C" & i).Value = Item
            .Rows(i).Copy
            .Rows(i).Insert
        Next Item
        .Rows(i).EntireRow.Delete

    Next i
End With

End Sub

I'm sure this code can be tweaked a bit, but at least this should give you a good starting point.

来源：https://stackoverflow.com/questions/61292597/reading-lbr-xml-as-txt-in-excel-vba

标签

excel

xml

vba