Microsoft VBA Excel 规律的Text文件转工作表Sheet

问题场景

简述：
在Excel的.xlsm文件中，有一个"RunControl"的sheet用来操控转换Text到指定的sheet中，需要在这个sheet上增加一个按钮，并在按钮上链接一个VBA程序，实现指定的功能。

以下是"RunControl"内的控制表格，五个标题名称以及另一名称（“FileName”）都已经通过名称管理器定义了各自的单元格。

Item	FolderName	Indicator	FilePath	Time
1	ROE		C:\User\Path1
2	PE	Y	C:\User\Path2
3	PB		C:\User\Path3

1. 需要循环"Item"这一列数据，从被定义为"Item"的单元格开始直到取不到数据为止，这是主循环是否结束的判断；接着在每一次循环中先判断对应的"Indicator"是否是"Y"，如果是"Y"则执行两个操作：①新建一个sheet（名称是对应的"FolderName"），②需要组合读取对应的"FilePath"和"FolderName"和另一个独立的单元格"FileName"，这样就可以打开对应位置的文件执行后续的操作。

   举个例子，现在主循环是"Item"为"2"的这一行，“Indicator"是"Y”，所以需要完成两个操作：①新建sheet命名为"PE"，②把对应的"FilePath"和"FolderName"和独立的"FileName"组合变成地址"C:\User\Path2\PE\Information.text"，通过地址打开"Information.text"这个文件。

2. 文件打开后每一行的格式是这样的：“S=1234|T=ABCD|N=Sample|Location=\Path”，需要按分隔符"|“切分每一列，使得全部数据都保存到对应的sheet（名称是对应的"FolderName”）中。每一行只需要直接根据每一行的分隔符判断是放入对应sheet的哪一列即可，无视连续的多个分隔符"|"。并且在切分完成后加入一个判断：如果切分结果中有某一行结果和其他行不一致，给出警告弹窗。完成以上操作后，记录操作的时间放入对应的"Time"中。

---

代码描述

Sub Run_Text()
    Dim wsRun As Worksheet
    Set wsRun = ThisWorkbook.Sheets("RunControl")
    
    Dim cell As Range
    Dim folderName As String, filePath As String, fileName As String
    Dim fullFilePath As String
    Dim newWs As Worksheet
    Dim lastRow As Long
    
    ' Turn off screen updating to reduce memory pressure
    Application.ScreenUpdating = False
    
    ' Get the value of the FileName named range
    fileName = ThisWorkbook.Names("FileName").RefersToRange.Value
    
    ' Get the last row of the Item named range
    lastRow = wsRun.Cells(wsRun.Rows.Count, wsRun.Range("Item").Column).End(xlUp).Row

    For Each cell In wsRun.Range("Item").Offset(1, 0).Resize(lastRow - wsRun.Range("Item").Row, 1)
        If wsRun.Range("Indicator").Offset(cell.Row - wsRun.Range("Item").Row, 0).Value = "Y" Then
        
            folderName = wsRun.Range("FolderName").Offset(cell.Row - wsRun.Range("Item").Row, 0).Value
            filePath = wsRun.Range("FilePath").Offset(cell.Row - wsRun.Range("Item").Row, 0).Value

            ' Create a new sheet with the folder name if it doesn't exist
            On Error Resume Next ' Ignore the error if the sheet exists
            Set newWs = ThisWorkbook.Sheets(folderName)
            If newWs Is Nothing Then ' Only add a new sheet if it does not exist
                Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                newWs.Name = folderName
            Else 
            	newWs.Cells.Clear
            End If
            On Error GoTo 0 ' Stop ignoring errors

            ' Combine the FilePath, FolderName and FileName
            fullFilePath = filePath & "\" & folderName & "\" & fileName

            ' Open and read the file
            Dim expectedColumnCount As Integer, currentColumnCount As Integer
		    Dim inconsistentData As Boolean
		    inconsistentData = False
		    expectedColumnCount = -1
		    
			' Declare a variable for the file number
			Dim fileNum As Integer
			fileNum = FreeFile
			
			' Open the text file for reading
			Open fullFilePath For Input As #fileNum
			
			' Read the entire file content into a string variable
			Dim fileContent As String
			fileContent = Input$(LOF(fileNum), #fileNum)
			
			' Close the file
			Close #fileNum
			
			' Split the file content into lines
			Dim fileLines() As String
			fileLines = Split(fileContent, vbCrLf)
			
            For Each line In fileLines
                If Trim(line) <> "" Then ' Ignore empty lines
                    lineData = Split(line, "|")
                    currentColumnCount = UBound(lineData) + 1 ' The number of columns in the current row

                    ' Set the expected number of columns at the first line of data
                    If expectedColumnCount = -1 Then
                        expectedColumnCount = currentColumnCount
                    End If

                    ' If the number of columns in the current row doesn't match the expected number, record the inconsistency
                    If currentColumnCount <> expectedColumnCount Then
                        inconsistentData = True
                        ' Exit For ' Do not continue processing the file, exit the loop directly
                    End If

                    ' Fill the data into the appropriate position on the worksheet
                    With newWs
                        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                        ' lastRow = 1
                        For colIndex = 0 To UBound(lineData)
                            .Cells(lastRow, colIndex + 1).Value = Trim(Mid(lineData(colIndex), InStr(lineData(colIndex), "=") + 1))
                        Next colIndex
                    End With
                End If
            Next line

            ' Check for inconsistent data
            If inconsistentData Then
                MsgBox "Please note, extra delimiters have caused abnormal splitting!", vbExclamation, "Data Split Warning"
            End If

            ' Record the time of the operation
            wsRun.Range("Time").Offset(cell.Row - wsRun.Range("Item").Row, 0).Value = Now()
			Set newWs = Nothing
        End If
    Next cell
End Sub

---