在 Excel 使用macro————仙盟创梦IDE

 Dim filePath As String
    Dim fileContent As String
   
    Dim lines() As String
    Dim dataArray() As String
    Dim lineCount As Long
    Dim maxCols As Long
    Dim i As Long, j As Long
    
    ' 文件路径
    filePath = ""
    
    ' 检查文件是否存在
    If Dir(filePath) = "" Then
        MsgBox "文件不存在: " & filePath, vbExclamation
        Exit Sub
    End If
    
    ' 读取文件内容
    On Error Resume Next
    fileContent = ReadFileContent(filePath)
    If Err.Number <> 0 Then
        MsgBox "读取文件时出错: " & Err.Description, vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    
    ' 按行分割内容
    lines = Split(fileContent, vbCrLf)
    lineCount = UBound(lines) + 1
    
    ' 确定最大列数
    maxCols = 0
    For i = 0 To UBound(lines)
        If Len(Trim(lines(i))) > 0 Then
            Dim cols() As String
            cols = Split(lines(i), ",")  ' 假设使用逗号分隔，根据实际情况修改
            If UBound(cols) + 1 > maxCols Then
                maxCols = UBound(cols) + 1
            End If
        End If
    Next i
    
    
    ' 重新定义数组大小
    ReDim dataArray(1 To lineCount, 1 To maxCols)
    
    ' 填充数组
    For i = 0 To UBound(lines)
        If Len(Trim(lines(i))) > 0 Then
            Dim cols() As String
            cols = Split(lines(i), ",")  ' 假设使用逗号分隔，根据实际情况修改
            
            For j = 0 To UBound(cols)
                dataArray(i + 1, j + 1) = cols(j)
            Next j
        End If
    Next i
    
    ' 在新工作表中显示数据（可选）
    DisplayDataInWorksheet dataArray, lineCount, maxCols
    
    ' 现在可以使用dataArray数组进行后续处理
    MsgBox "文件已成功读取并解析为数组!", vbInformation

显示数据表

' 在工作表中显示数组数据的辅助函数
Sub DisplayDataInWorksheet(dataArray() As String, rows As Long, cols As Long)
    Dim ws As Worksheet
    
    ' 创建新工作表
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "人员权重数据"
    
    ' 填充数据
    Dim i As Long, j As Long
    For i = 1 To rows
        For j = 1 To cols
            ws.Cells(i, j).Value = dataArray(i, j)
        Next j
    Next i
    
    ' 自动调整列宽
    ws.Columns.AutoFit
End Sub

读取文件

' 读取文件内容的辅助函数
Function ReadFileContent(filePath As String) As String
    Dim fileNum As Integer
    Dim content As String
    
    fileNum = FreeFile
    
    Open filePath For Input As #fileNum
    content = Input$(LOF(fileNum), #fileNum)
    Close #fileNum
    
    ReadFileContent = content
End Function

读取文件

unction 仙盟创梦macro_招标系统_读取文件(filePath As String) As String

' 方法一：使用FSO
    fileContent = ReadTextFile_FSO(filePath)
    If fileContent <> "" Then
        MsgBox "文件内容长度: " & Len(fileContent), vbInformation
    End If
    
    Dim fileNum As Integer
    Dim content As String
    Dim tempStr As String
    
    fileNum = FreeFile
    
    On Error GoTo ErrorHandler
    
    Open filePath For Input As #fileNum
    
    ' 安全读取文件内容
    Do While Not EOF(fileNum)
        Line Input #fileNum, tempStr
        content = content & tempStr & vbCrLf
    Loop
    
    Close #fileNum
    ReadFileSafely = content
    Exit Function
    
ErrorHandler:
    Close #fileNum  ' 确保关闭文件
    MsgBox "读取文件时出错: " & Err.Description, vbCritical
    ReadFileSafely = ""
End Function

文件读取

Function 仙盟创梦macro_招标系统_读取文件2(filePath As String) As String
    Dim fso As Object
    Dim file As Object
    
    ' 创建FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 检查文件是否存在
    If fso.FileExists(filePath) Then
        ' 打开文件并读取全部内容
        Set file = fso.OpenTextFile(filePath, 1, False) ' 1 = ForReading
        ReadTextFile_FSO = file.ReadAll
        file.Close
    Else
        MsgBox "文件不存在: " & filePath, vbExclamation
        ReadTextFile_FSO = ""
    End If
    
    ' 释放对象
    Set file = Nothing
    Set fso = Nothing
    仙盟创梦macro_招标系统_读取文件2 = ReadTextFile_FSO
End Function

数据显示

' 在工作表中显示数组数据的辅助函数
Sub DisplayDataInWorksheet(dataArray() As String, rows As Long, cols As Long)
    Dim ws As Worksheet
    
    ' 创建新工作表
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "人员权重数据3"
    
    ' 填充数据
    Dim i As Long, j As Long
    For i = 1 To rows
        For j = 1 To cols
            'ws.Cells(i, j).Value = dataArray(i, j)
             ws.Cells(i, j).Value = dataArray(j)
        Next j
    Next i
    
    ' 自动调整列宽
    ws.Columns.AutoFit
End Sub