Fatal编程技术网
  • excel/
  • 在vba中将文本文件中的数据提取到Excel中

在vba中将文本文件中的数据提取到Excel中

excel vba

在vba中将文本文件中的数据提取到Excel中,excel,vba,split,text-files,Excel,Vba,Split,Text Files,我需要将文本文件中的数据提取到Excel文件中。我曾经问过 但经过几周的尝试，仍然没有成功，所以我用vba代替。 以下是我所拥有的： Sub ExtractData() Dim filename As String, nextrow As Long, MyFolder As String Dim MyFile As String, text As String, textline As String, filedate As String Dim filenum As Integer Dim

我需要将文本文件中的数据提取到Excel文件中。我曾经问过

但经过几周的尝试，仍然没有成功，所以我用vba代替。 以下是我所拥有的：

Sub ExtractData()

Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
Dim idx%

MyFolder = "D:\Automation\VSWR\"
MyFile = Dir(MyFolder & "VSWR W51.txt")

nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

Cells(1, 1).Value = "eNodeBName"
Cells(1, 2).Value = "Time"
Cells(1, 3).Value = "MML SN"
Cells(1, 4).Value = "MML Command"
Cells(1, 5).Value = "Retcode"
Cells(1, 6).Value = "Explain_info"
Cells(1, 7).Value = "Cabinet No."
Cells(1, 8).Value = "Subrack No."
Cells(1, 9).Value = "Slot No."
Cells(1, 10).Value = "TX Channel No."
Cells(1, 11).Value = "VSWR(0.01)"
'Columns(1).EntireColumn.AutoFit

Do While MyFile <> ""

Open (MyFolder & MyFile) For Input As #1

    Do Until EOF(1)
        Line Input #1, textline 'read a line
        
        idx = InStr(textline, "NE")
        If idx > 0 Then
            'ActiveSheet.Cells(nextrow, "A").Value = Mid(textline, idx + 5)
            ActiveSheet.Cells(nextrow, "A").Value = Mid(textline, filenum + 5)
        End If

        idx = InStr(textline, "Report")
        If idx > 0 Then
            ActiveSheet.Cells(nextrow, "B").Value = Right(textline, filenum + 19)
        End If
        
        idx = InStr(textline, "O&M")
        If idx > 0 Then
            ActiveSheet.Cells(nextrow, "C").Value = ("O&M" & Mid(textline, filenum + 4))
        End If
        
        
        idx = InStr(textline, "MML Session")
        If idx > 0 Then
            ActiveSheet.Cells(nextrow, "D").Value = "DSP VSWR:;"
        End If
        
        
        idx = InStr(textline, "RETCODE")
        If idx > 0 Then
            ActiveSheet.Cells(nextrow, "E").Value = "0"
        End If
           
        idx = InStr(textline, "RETCODE")
        If idx > 0 Then
            ActiveSheet.Cells(nextrow, "F").Value = Mid(textline, filenum + 12)

            'nextrow = nextrow + 1 'now move to next row
        End If
                 
        idx = InStr(textline, "Cabinet No.")
        If idx > 0 Then
        
            Line Input #1, textline
            Line Input #1, textline
            ActiveSheet.Cells(nextrow, "G").Value = Mid(textline, filenum + 1)
            
            nextrow = nextrow + 1 'now move to next row
        End If
    Loop  
Close #1
MyFile = Dir()

Loop
End Sub
文本文件中的示例输入

我想要的输出应该是这样的

提前感谢，非常感谢。

有多种方法可以实现这一点，这里有一种方法使用
Split（）
方法，使用示例文件中的示例行：

Dim s As String
s = "0            60           0         0               108"
' Reduce delimiting spaces to 1
s = RemoveMultipleSpaces(s)

' Split the string into an array
Dim avnt As Variant
avnt = Split(s, " ")

Dim i As Long

For i = LBound(avnt) To UBound(avnt)
   Debug.Print "i: " & CStr(i); ", Value: " & avnt(i); ", Len: " & Len(avnt(i))
Next

' Results in:
' i: 0, Value: 0, Len: 1
' i: 1, Value: 60, Len: 2
' i: 2, Value: 0, Len: 1
' i: 3, Value: 0, Len: 1
' i: 4, Value: 108, Len: 3

' ---

Function RemoveMultipleSpaces(ByVal sSource As String) As String
   ' Remove all occurances of more than 1 space from a string
   Do While InStr(sSource, "  ") > 0
      sSource = Replace(sSource, "  ", " ")
   Loop
   
   RemoveMultipleSpaces = sSource

End Function
正如下面@vbasic208所建议的，在这种情况下，目标是删除多个空格，
Application.Trim
是更好的解决方案

由于我的答案可以很容易地调整为适合空格以外的其他字符，因此我将其保留在此处“原样”。

使用和分隔列

idx = InStr(textline, "Cabinet No.")
If idx > 0 Then
        
Line Input #1, textline
Line Input #1, textline
ActiveSheet.Cells(nextrow, "G").Value = Mid(textline, filenum + 1)
            
nextrow = nextrow + 1 'now move to next row
End If`

选项显式
子数据（）
将wb设置为工作簿，ws设置为工作表
将MyFile设置为字符串，将MyFolder设置为字符串
Dim textline作为字符串，ar作为变量
我长，n长，计数长
尺寸环（10）为字符串，t0为单个
t0=计时器
MyFolder=“D:\Automation\VSWR\”
MyFile=Dir（MyFolder&“VSWR W51.txt”）
设置wb=ThisWorkbook
设置ws=wb.Sheets（1）
ws.Cells.Clear
i=ws.Cells（Rows.count，“A”）.End（xlUp）。Row+1
ws.Range（“A1:K1”）=数组（“eNodeBName”、“Time”、“MML SN”、“MML命令”、“Retcode”_
“解释信息”、“机柜号”、“子架号”、“插槽号”_
“TX信道号”，“驻波比（0.01）”）
打开（MyFolder&MyFile）作为#1输入
直到EOF（1）为止
如果count Mod 10000=0，则Application.StatusBar=count
行输入#1，文本行：计数=计数+1
如果InStr（文本行“--END”）>0，则
清除“arOut”清除数组
ElseIf InStr（文本行，“NE”）>0然后
arOut（0）=中间（文本行，5）
ElseIf InStr（文本行，“报告”）>0然后
arOut（1）=右侧（文本行，19）
ElseIf InStr（文本行，“O&M”）>0然后
arOut（2）=“O&M”和Mid（文本行，4）
ElseIf InStr（文本行，“MML会话”）>0然后
arOut（3）=“DSP驻波比：
ElseIf InStr（文本行，“RETCODE”）>0然后
arOut（4）=中间（文本行，11,1）
arOut（5）=中间（文本行，12）
ElseIf InStr（文本行，“机柜号”）大于0
行输入#1，文本行：计数=计数+1
行输入#1，文本行：计数=计数+1
左行时执行（文本行，7）”（数字）
textline=Application.Trim（textline）
ar=拆分（文本行“”）
'Debug.Print count，文本行，UBound（ar）
对于n=0到4
arOut（6+n）=ar（n）
下一个
ws.Range（“A”&i&“：K”&i）.Value=arOut
i=i+1'现在移动到下一行
行输入#1，文本行：计数=计数+1
环
如果结束
环
关闭#1
MsgBox格式（计数，“#，##0”）和“读取行”，vbInformation，Int（计时器-t0）和“秒”
端接头
文本到Excel
  • 请注意，这将为您提供的文件生成超过125.000行。请确保未超过
    1048576
    Excel行数限制。目前，我的计算机上提供的文件大约需要6秒
代码

Option Explicit

Sub ExtractData()
    
    Const FolderPath = "D:\Automation\VSWR\"
    Const FilePattern As String = "*.txt" ' or rather "VSWR W5*.txt"
    Const dName As String = "Sheet1"
    Const dCol As String = "A"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Application.ScreenUpdating = False
    
    Dim dCell As Range
    With wb.Worksheets(dName)
        ' Write headers.
        .Cells(1, 1).Value = "eNodeBName"
        .Cells(1, 2).Value = "Time"
        .Cells(1, 3).Value = "MML SN"
        .Cells(1, 4).Value = "MML Command"
        .Cells(1, 5).Value = "Retcode"
        .Cells(1, 6).Value = "Explain_info"
        .Cells(1, 7).Value = "Cabinet No."
        .Cells(1, 8).Value = "Subrack No."
        .Cells(1, 9).Value = "Slot No."
        .Cells(1, 10).Value = "TX Channel No."
        .Cells(1, 11).Value = "VSWR(0.01)"
        ' Determine next available cell.
        Set dCell = .Cells(.Rows.count, dCol).End(xlUp).Offset(1)
    End With
    
    Dim FileNum As Long: FileNum = FreeFile
    Dim FileName As String: FileName = Dir(FolderPath & FilePattern)
    Dim RowLabels(6) As Variant
    Dim Data() As Variant
    Dim Result As Variant
    Dim r As Long
    Dim c As Long
    Dim TextLine As String
    
    Do While FileName <> ""
        
        Open (FolderPath & FileName) For Input As FileNum
    
            Do Until EOF(FileNum)
                
                Line Input #FileNum, TextLine 'read a line
                
                If InStr(TextLine, "NE : ") = 1 Then
                    RowLabels(1) = Mid(TextLine, 5)
                ElseIf InStr(TextLine, "Report : +++    ") = 1 Then
                    RowLabels(2) = Right(TextLine, 19)
                ElseIf InStr(TextLine, "O&M    ") = 1 Then
                    RowLabels(3) = ("O&M " & Mid(TextLine, 8))
                ElseIf InStr(TextLine, "MML Session") > 0 Then
                    RowLabels(4) = "DSP VSWR:;"
                ElseIf InStr(TextLine, "RETCODE = ") = 1 Then
                    RowLabels(5) = "0"
                    RowLabels(6) = Mid(TextLine, 12)
                ElseIf InStr(TextLine, "Cabinet No.  Subrack No.  Slot No." _
                    & "  TX Channel No.  VSWR(0.01)") = 1 Then
                    Line Input #FileNum, TextLine
                    c = 0
                    Do
                        Line Input #FileNum, TextLine
                        Select Case True
                        Case InStr(TextLine, "(Number of results = ") = 1
                            Exit Do
                        Case Len(TextLine) = 0
                        Case Else
                            c = c + 1
                            ReDim Preserve Data(7 To 11, 1 To c)
                            Data(7, c) = Trim(Mid(TextLine, 1, 11))
                            Data(8, c) = Trim(Mid(TextLine, 12, 13))
                            Data(9, c) = Trim(Mid(TextLine, 25, 10))
                            Data(10, c) = Trim(Mid(TextLine, 35, 16))
                            Data(11, c) = Trim(Mid(TextLine, 51))
                        End Select
                    Loop
                    ReDim Result(1 To c, 1 To 11)
                    For r = 1 To c
                        For c = 1 To 6
                            Result(r, c) = RowLabels(c)
                        Next c
                        For c = 7 To 11
                            Result(r, c) = Data(c, r)
                        Next c
                    Next r
                    dCell.Resize(r - 1, 11).Value = Result
                    Set dCell = dCell.Offset(r - 1)
                End If
            
            Loop
        
        Close FileNum
        FileName = Dir()
    
    Loop
    
    With dCell.Worksheet
        .UsedRange.EntireColumn.AutoFit
    End With

    Application.ScreenUpdating = True

End Sub

选项显式
子数据（）
Const FolderPath=“D:\Automation\VSWR\”
Const FilePattern为String=“*.txt”或更确切地说是“VSWR W5*.txt”
Const dName As String=“Sheet1”
Const dCol As String=“A”
将wb设置为工作簿：设置wb=ThisWorkbook
Application.ScreenUpdating=False
Dim dCell As范围
带wb.工作表（dName）
'写入标题。
.Cells（1,1）.Value=“eNodeBName”
.Cells（1,2）.Value=“时间”
.Cells（1,3）.Value=“MML序号”
.Cells（1,4）.Value=“MML命令”
.Cells（1,5）.Value=“Retcode”
.Cells（1,6）.Value=“解释信息”
.Cells（1,7）.Value=“机柜号”
.Cells（1,8）.Value=“子框编号”
.Cells（1,9）.Value=“插槽编号”
.Cells（1，10）.Value=“发送通道号。”
.Cells（1,11）.Value=“电压驻波比（0.01）”
'确定下一个可用单元格。
设置dCell=.Cells（.Rows.count，dCol）.End（xlUp）.Offset（1）
以
Dim FileNum的长度：FileNum=FreeFile
作为字符串的Dim文件名：FileName=Dir（FolderPath和FilePattern）
变暗行标签（6）作为变型
Dim Data（）作为变量
作为变量的模糊结果
变暗，变长
尺寸c与长度相同
将文本行变暗为字符串
文件名“”时执行此操作
打开（FolderPath和FileName）作为FileNum输入
执行直到EOF（FileNum）
行输入#FileNum，TextLine'读取行
如果InStr（文本行，“NE:”）=1，则
行标签（1）=中间（文本行，5）
ElseIf InStr（文本行，“报告：+++”）=1
行标签（2）=右侧（文本行，19）
其他仪表（文本行，“O&M”）=1
行标签（3）=（“O&M”和Mid（文本行，8））
ElseIf InStr（文本行，“MML会话”）>0然后
行标签（4）=“DSP VSWR:；”
ElseIf InStr（文本行，“RETCODE=”）=1然后
行标签（5）=“0”
行标签（6）=中间（文本行，12）
ElseIf InStr（文本行，“机柜号、机架号、插槽号”_
&“TX信道号VSWR（0.01）”）=1，则
行输入#FileNum，TextLine
c=0
做
行输入#F