在vba中循环以获得正确的结果

Question

我正在尝试以适当的格式获得Excel结果，但我在循环和条件中非常困惑并且整晚都在尝试并且仍然无法弄明白。

结构简单但编码复杂，如果可能的话，如果代码是VBscript友好的话会更好。

以下代码中的实际表格：

     E1    E2   E1
ABC  P     F
Xyz  P     P

预期的输出表是：

     E1    E2
ABC  P     F
PQR  F     P
Xyz  P     P

文本文件：我有6个这样的文件

Env>E1
TestName>ABC
Result>P

以下是代码：

    Public Sub Temp()
    ThisWorkbook.Sheets(1).Range("a1:D10").ClearContents
    Dim MyObj As Object, MySource As Object, file As Variant
   Set MyObj = CreateObject("Scripting.FileSystemObject")
   Set MySource = MyObj.GetFolder("C:\Users\admin\Desktop\looping\xmlfile")
   For Each file In MySource.Files
     If InStr(file.Name, "txt") > 0 Then
       'myFile = file.Path
       fileSpec = file.Path '"C:\Prac_Session\OLB.xml" 'change the path to whatever yours ought to be
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTS = objFSO.OpenTextFile(fileSpec, ForReading)
    rowupdate = 1
    colupdate = 1
    Open fileSpec For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
            ''debug.Print textline
                If InStr(textline, "TestName>") > 0 Then 'Read line by line and store all lines in strContents
                    For rw = 2 To 4
                        If Sheet1.Cells(rw, 1) <> Mid(textline, 10, Len(textline) - 9) Then
                            If Sheet1.Cells(rw, 1) = "" Then
                                Sheet1.Cells(rw, 1).Value = Mid(textline, 10, Len(textline) - 9)
                                rowupdate = rw
                                Exit For
                            ElseIf Sheet1.Cells(rw, 1) = Mid(textline, 10, Len(textline) - 9) Then
                                rowupdate = rw
                                Exit For
                            ElseIf Sheet1.Cells(rw, 1) <> Mid(textline, 10, Len(textline) - 9) Then
                                Sheet1.Cells(rw + 1, 1) = Mid(textline, 10, Len(textline) - 9)
                                 rowupdate = rw
                                 Exit For
                            End If
                        End If
                    Next
                End If
                If InStr(textline, "Env>") > 0 Then 'Read line by line and store all lines in strContents
                    For col = 2 To 3
                        If Sheet1.Cells(1, col) <> Mid(textline, 5, Len(textline) - 4) Then
                            If Sheet1.Cells(1, col) = "" Then
                                Sheet1.Cells(1, col).Value = Mid(textline, 5, Len(textline) - 4)
                                colupdate = col
                                Exit For
                            ElseIf Sheet1.Cells(1, col).Value = Mid(textline, 5, Len(textline) - 4) Then
                                colupdate = col
                                Exit For
                            ElseIf Sheet1.Cells(1, col) <> Mid(textline, 5, Len(textline) - 4) Then
                                Sheet1.Cells(1, col + 1) = Mid(textline, 5, Len(textline) - 4)
                                colupdate = col
                                Exit For
                            End If
                        End If
                    Next
                End If
                If InStr(textline, "Result>") > 0 Then 'Read line by line and store all lines in strContents
                    Sheet1.Cells(rowupdate, colupdate).Value = Mid(textline, 8, Len(textline) - 7)
                    rowupdate = 1
                    colupdate = 1
                End If
    Loop
    Close #1
  End If
  Next file
End Sub

Answer 1

终于我明白了！！！！。这个现在解决了。谢谢。

Public Sub Temp()
ThisWorkbook.Sheets(1).Range("a1:D10").ClearContents
Dim MyObj As Object, MySource As Object, file As Variant
Set MyObj = CreateObject("Scripting.FileSystemObject")
Set MySource = MyObj.GetFolder("C:\Users\admin\Desktop\looping\xmlfile")
rowupdate = 2
colupdate = 2
For Each file In MySource.Files
 If InStr(file.Name, "txt") > 0 Then
   'myFile = file.Path
   fileSpec = file.Path '"C:\Prac_Session\OLB.xml" 'change the path to whatever yours ought to be
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTS = objFSO.OpenTextFile(fileSpec, ForReading)

Open fileSpec For Input As #1
Do Until EOF(1)
    Line Input #1, textline
        ''debug.Print textline
    spltext = Split(textline, ">")
    Select Case spltext(0)
        Case "TestName"
            Set searchtext = ThisWorkbook.Sheets(1).Range("A1:A1000").Find(spltext(1), LookIn:=xlValues)
            If Not searchtext Is Nothing Then
            rowspl = Split(searchtext.Address, "$")
                lrow = rowspl(2) 'Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
                Sheet1.Cells(lrow, 1) = spltext(1)
            Else
                Sheet1.Cells(rowupdate, 1) = spltext(1)
                lrow = rowupdate
            End If
        Case "Env"
            Set searchtext = ThisWorkbook.Sheets(1).Range("A1:ZZ1").Find(spltext(1), LookIn:=xlValues)
            If Not searchtext Is Nothing Then
                colspl = Split(searchtext.Address, "$")
                lcol = colspl(1) 'Cells(1, Columns.Count).End(xlToLeft).Column
                Sheet1.Range(lcol & "1") = spltext(1)
            Else
                Sheet1.Cells(1, colupdate) = spltext(1)
                lcol = colupdate
            End If
        Case "Result"
            If lcol = "0" Or lcol = "1" Or lcol = "2" Or lcol = "3" Or lcol = "4" Then
            Sheet1.Cells(lrow, lcol) = spltext(1)
            rowupdate = rowupdate + 1
            colupdate = colupdate + 1
            Else
            Sheet1.Range(lcol & "" & lrow).Value = spltext(1)
            'rowupdate = rowupdate + 1
            'colupdate = colupdate + 1
            End If
    End Select
Loop
Close #1
End If
Next file
End Sub