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 indicatorCell As Range
    Dim lastRow As Long
    
    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
    
    ' 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
            End If
            On Error GoTo 0 ' Stop ignoring errors

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

            ' Open and read the file
			' 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
                        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()

        End If
    Next cell
End Sub

---