问题场景

简述：
在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 WorksheetSet wsRun = ThisWorkbook.Sheets("RunControl")Dim cell As RangeDim folderName As String, filePath As String, fileName As StringDim fullFilePath As StringDim newWs As WorksheetDim indicatorCell As RangeDim lastRow As LongDim expectedColumnCount As Integer, currentColumnCount As IntegerDim inconsistentData As BooleaninconsistentData = FalseexpectedColumnCount = -1' Declare a variable for the file numberDim fileNum As IntegerfileNum = FreeFile' Turn off screen updating to reduce memory pressureApplication.ScreenUpdating = False' Get the value of the FileName named rangefileName = ThisWorkbook.Names("FileName").RefersToRange.Value' Get the last row of the Item named rangelastRow = wsRun.Cells(wsRun.Rows.Count, wsRun.Range("Item").Column).End(xlUp).RowFor 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" ThenfolderName = wsRun.Range("FolderName").Offset(cell.Row - wsRun.Range("Item").Row, 0).ValuefilePath = wsRun.Range("FilePath").Offset(cell.Row - wsRun.Range("Item").Row, 0).Value' Create a new sheet with the folder name if it doesn't existOn Error Resume Next ' Ignore the error if the sheet existsSet newWs = ThisWorkbook.Sheets(folderName)If newWs Is Nothing Then ' Only add a new sheet if it does not existSet newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))newWs.Name = folderNameEnd IfOn Error GoTo 0 ' Stop ignoring errors' Combine the FilePath, FolderName and FileNamefullFilePath = filePath & "\" & folderName & "\" & fileName' Open and read the file' Declare a variable for the file numberDim fileNum As IntegerfileNum = FreeFile' Open the text file for readingOpen fullFilePath For Input As #fileNum' Read the entire file content into a string variableDim fileContent As StringfileContent = Input$(LOF(fileNum), #fileNum)' Close the fileClose #fileNum' Split the file content into linesDim fileLines() As StringfileLines = Split(fileContent, vbCrLf)For Each line In fileLinesIf Trim(line) <> "" Then ' Ignore empty lineslineData = 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 dataIf expectedColumnCount = -1 ThenexpectedColumnCount = currentColumnCountEnd If' If the number of columns in the current row doesn't match the expected number, record the inconsistencyIf currentColumnCount <> expectedColumnCount TheninconsistentData = True' Exit For ' Do not continue processing the file, exit the loop directlyEnd If' Fill the data into the appropriate position on the worksheetWith newWslastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1For colIndex = 0 To UBound(lineData).Cells(lastRow, colIndex + 1).Value = Trim(Mid(lineData(colIndex), InStr(lineData(colIndex), "=") + 1))Next colIndexEnd WithEnd IfNext line' Check for inconsistent dataIf inconsistentData ThenMsgBox "Please note, extra delimiters have caused abnormal splitting!", vbExclamation, "Data Split Warning"End If' Record the time of the operationwsRun.Range("Time").Offset(cell.Row - wsRun.Range("Item").Row, 0).Value = Now()End IfNext cell
End Sub

---