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

相关推荐
程序员 小柴6 分钟前
RabbitMQ死信队列
java·rabbitmq·java-rabbitmq
小赖同学吖7 分钟前
Java 中的继承与多态:面向对象编程的核心特性
java·开发语言
Seven9730 分钟前
【Guava】集合工具Collections2
java
MaCa .BaKa31 分钟前
25-智慧旅游系统(协同算法)三端
java·javascript·vue.js·spring boot·tomcat·maven·旅游
西元.36 分钟前
线程等待与唤醒的几种方法与注意事项
java·开发语言
浪游东戴河37 分钟前
电脑基础之excel基础操作
excel·表格·对齐·电脑基础
栗筝i39 分钟前
Spring 核心技术解析【纯干货版】- XVI:Spring 网络模块 Spring-WebMvc 模块精讲
java·网络·spring
落榜程序员1 小时前
Java基础-25-继承-方法重写-子类构造器的特点-构造器this的调用
java·开发语言
Debug 熊猫1 小时前
【Java基础】10章、单例模式、final关键字的使用技巧和使用细节、单例模式-懒汉式、单例模式-饿汉式【3】
java·javascript·后端·单例模式
shaoweijava1 小时前
基于SpringBoot的求职招聘网站系统(源码+数据库)
java·spring boot·mysql·spring