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"中。


代码描述

c 复制代码
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

相关推荐
失散1318 小时前
分布式专题——10.2 ShardingSphere-JDBC分库分表实战与讲解
java·分布式·架构·shardingsphere·分库分表
失散1320 小时前
分布式专题——10.4 ShardingSphere-Proxy服务端分库分表
java·分布式·架构·shardingsphere·分库分表
Bellafu66621 小时前
spring项目部署后为什么会生成 logback-spring.xml文件
java
递归不收敛21 小时前
一、Java 基础入门:从 0 到 1 认识 Java(详细笔记)
java·开发语言·笔记
沐浴露z1 天前
【Java SpringAI智能体开发学习 | 2】SpringAI 实用特性:自定义Advisor,结构化输出,对话记忆持久化,prompt模板,多模态
java·spring·springai
小沈同学呀1 天前
创建一个Spring Boot Starter风格的Basic认证SDK
java·spring boot·后端
码农小伙1 天前
通俗易懂地讲解JAVA的BIO、NIO、AIO
java·nio
不要再敲了1 天前
JDBC从入门到面试:全面掌握Java数据库连接技术
java·数据库·面试
潇I洒1 天前
若依4.8.1打包war后在Tomcat无法运行,404报错的一个解决方法
java·tomcat·ruoyi·若依·404
Funcy1 天前
XxlJob 源码分析05:执行器注册流程
java