VBA批量读取txt文档目标数据并分组处理

最新推荐文章于 2024-08-06 09:15:50 发布

Script_Man

最新推荐文章于 2024-08-06 09:15:50 发布

阅读量699

点赞数 13

分类专栏： VBA进阶文章标签：开发语言 .net 经验分享 windows VB VBA txt数据处理

本文链接：https://blog.csdn.net/m0_62872215/article/details/136402966

版权

VBA进阶专栏收录该内容

14 篇文章 6 订阅

订阅专栏

VBA在批量处理txt等文本文件的数据是其数据处理的一大重要应用，实际在处理txt文档往往需要提取多个测试料的多个目标数值，而且还要将提取的数值进一步处理，如求取平均值，最小值等，能够直观地看到一组数据的规律；将超出规格的数据进行标识，可以直观看到某些数据异常区域。

下述的实例就是需要提取txt文档中一颗料多个目标值，并利用一维数组的方式写入到单元格中，进而求取每一组值的平均值和最小值，然后循环提取进行每一个测试料的数据，最后将每一颗料的多组数据进行汇总成群数据，得到一个简洁的数据表，能偶较为直观知道所有数据群里面的每组平均值，最小值，组间比值以及超出规格的数量及比例，即一个txt文档的所有数据汇总成一行数据，简洁高效，可读性强。

以下是具体的实现方法。

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'这部分代码是读取txt文档多个目标数据并用数组写入单元格
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Sub Data_SFR()
    Dim Bookfile As String, shOCHFA10 As Object, sh_Start As Object    '定义变量名称
    
    Application.ScreenUpdating = False   '禁止屏幕刷新

    Application.Calculation = xlCalculationManual   '计算模式为手动
    
    Bookfile = ThisWorkbook.Name
         
    Set shOCHFA10 = Workbooks(Bookfile).Sheets("OCHFA10")		'定义worksheet
    
    Set sh_Start = Workbooks(Bookfile).Sheets("Start")		'定义worksheet

    
    shOCHFA10.Activate

    Or_i_30mm = 0
    
    Do While shOCHFA10.Cells(Or_i_30mm + 4, 3) <> ""     '循环判断第3列的空白行是否为空，非空行数为Or_i_30mm
    
        Or_i_30mm = Or_i_30mm + 1
        
    Loop
    


    Dim fso As Object, sFile As Object, blnExist As Boolean     '定义对象变量    
    Dim FileName As String, LineText As Variant, i As Integer, iCol As Integer
    
    Const ForReading = 1   '指定常量
    
    Set fso = CreateObject("Scripting.FileSystemObject")    '创建FileSystemObject对象
    
    ChDrive "D"
    ChDir "D:\OCHFA10\OCHFA10 SLT Data"
    
    Openfilename = Application.GetOpenFilename("raw files (*.txt), *.txt")   '打开类型为txt的文件，即筛选打开文件类型
    
    sh_Start.Cells(5, 3) = Openfilename     '写入读取的文件名称  
    sh_Start.Cells(9, 3) = Now()            '写入当前的开文件时间

    blnExist = fso.FileExists(Openfilename) '判断文件是否存在，如果不存在，则退出过程
    
    If Not blnExist Then MsgBox "文件不存在！": Exit Sub
    
    Set sFile = fso.OpenTextFile(Openfilename, ForReading) '创建并打开名为sFile的TextStream对象
    
    Text = Split(Openfilename, "\")       '拆分字符串
        
    lot_i = UBound(Text)
    sh_Start.Cells(7, 3) = Text(UBound(Text) - 2)
    A_start_30mm = Or_i_30mm + 4    '标题行占用4行，变量要加上4
    kj_30mm = 1
    
    i = 0
    j = 0
    Light_i = 0

    Do While Not sFile.AtEndOfStream    '如果不是文本文件的尾端，则读取数据
        
        LineText = sFile.ReadLine       '逐行读取字符串
        
        SFR_Text = Split(LineText, " ")    '逐行拆分字符串
        
        SFR_No = UBound(SFR_Text)         '获取读取的字符串最后序号的拆分字符串
      
        
        End_Text = Split(LineText, ".")   '逐行拆分字符串
        
        END_No = UBound(SFR_Text)
        
        If END_No > 0 Then

            LineText_Array = Right(SFR_Text(1), 17)   'right函数截取SFR_Text(1)字符串

            Else
        End If

        
        LineText_Start = Right(Left(LineText, 31), 9)	'right函数和left函数组合截取LineText特定字符串，与目标字符串对比
        
        
        Chart_30mm = Right(LineText, 19)           'right函数截取LineText特定字符串，与目标字符串对比

        MTFValue_Check = Right(LineText_TVL, 9)	  'right函数截取LineText特定字符串，与目标字符串对比
             
  
        If SFR_No > 2 Then
        
            SFR_Coor = SFR_Text(SFR_No - 2)
            O_C = SFR_Text(SFR_No - 2)
'            LightMode = SFR_Text(SFR_No - 3)
            OTP_Text = SFR_Text(SFR_No - 1)             '以各种条件拆分整行字符串，取特定字符串
            LineText_TVL = SFR_Text(SFR_No - 1)
            LineText_Light = SFR_Text(SFR_No - 3)
            Else
        End If
        
        
        If LineText_TVL = "(210)" Then     '定向标识，当读取内容行的字节无法区别，则采用跨行识别
            Light_i = 1
        End If
        
        If LineText_TVL = "(70)" Then      '定向标识
            Light_j = 1
        End If
        
        
        Dim Arr_30mm(0 To 52)
        Dim Arr_Light(1 To 4)
        
       
        If Light_j = 1 And OTP_Text = "OTPCode" Then   ''定向标识的应用

            shOCHFA10.Cells(A_start_30mm, 5) = SFR_Text(SFR_No)
            Else

        End If
        
        
        If O_C = sh_Start.Cells(1, 3) Then   
            
            Arr_30mm(0) = SFR_Text(SFR_No)		'将目标字符串所在行的截取字符串写入一维数组第一个值
                    
            Else
                    
        End If
                

        
        For LightMode_i = 0 To 3

                If Light_i = 1 And LineText_Light = sh_Start.Cells(2, LightMode_i + 2) Then    '定向标识应用&判断提取字符串与目标字符串是否相同

                    Arr_Light(1 + LightMode_i) = SFR_Text(SFR_No)		'将目标字符串所在行的指定字符串写入一维动态数组

                    Else

                End If

        Next LightMode_i
        
        
        For TVL_i = 1 To 52
            
                If LineText_TVL = sh_Start.Cells(1, TVL_i + 3) Then		'判断截取字符串是否与目标字符串相同
        
                    Arr_30mm(TVL_i) = SFR_Text(SFR_No)		''将目标字符串所在行的指定字符串写入一维动态数组
                    
                Else
                    
                End If
              
        Next TVL_i
        

'        If SFR_Coor = "Enable" And SFR_No > 7 Then
'
'            Arr_Coor(Coor_i) = SFR_Text(SFR_No - 6) & "/" & SFR_Text(SFR_No - 5) & "/" & SFR_Text(SFR_No - 4) & "/" & SFR_Text(SFR_No - 3)
'            Coor_i = Coor_i + 1
'
'            Else
'
'        End If
        

        If LineText_Array = "SFRMxNWithThd_Raw" Then     '
            i_Spec = i_Spec + 1

            If i_Spec Mod 4 = 2 Then   '判断"SFRMxNWithThd_Raw"字符串出现的2N的奇偶行，若为2N奇数行
                shOCHFA10.Cells(A_start_30mm, 3) = sh_Start.Cells(7, 3)
                shOCHFA10.Cells(A_start_30mm, 4) = kj_30mm
'               shOCHTA10.Cells(A_start_30mm, 6) = SFR_Text(SFR_No)
'               shOCHTA10.Cells(A_start_30mm, 2) = Right(Left(LineText, 20), 19)
            
                Range(shOCHFA10.Cells(A_start_30mm, 11), shOCHFA10.Cells(A_start_30mm, 63)) = Arr_30mm   '数组的值写入单元格
                Range(shOCHFA10.Cells(A_start_30mm, 7), shOCHFA10.Cells(A_start_30mm, 10)) = Arr_Light   '数组的值写入单元格
                            
                
            ElseIf i_Spec Mod 4 = 0 Then	'判断"SFRMxNWithThd_Raw"字符串出现的2N的奇偶行，若为2N偶数行
            
                Range(shOCHFA10.Cells(A_start_30mm, 85), shOCHFA10.Cells(A_start_30mm, 137)) = Arr_30mm
                
                Light_i = 0
                Light_j = 0
                
                kj_30mm = kj_30mm + 1
            
                A_start_30mm = A_start_30mm + 1
        
                Erase Arr_30mm()	'清除一维数组的数据，若将动态一维数组改为二维动态数组Arr_30mm(A_start_30mm，TVL_i)，这一行代码可以去掉
                Erase Arr_Light()	''清除一维数组的数据，若将动态一维数组改为二维动态数组Arr_Light(,A_start_30mm，1 + LightMode_i)，这一行代码可以去掉
                              
            Else
            End If

        End If

        
'        If LineText_Start = "Final Bin" Then

''            shOCHTA10.Cells(A_start_30mm, 3) = sh_Start.Cells(7, 3)
''            shOCHTA10.Cells(A_start_30mm, 4) = kj_30mm
'            shOCHFA10.Cells(A_start_30mm - 1, 6) = SFR_Text(SFR_No)
'
'            shOCHFA10.Cells(A_start_30mm - 1, 2) = Right(Left(LineText, 20), 19)
''
'        Else
''
'        End If
        
        If SFR_No > 9 Then
            If Right(End_Text(0), 21) = "End of SLT II testing" Then	'判断局部字符串的终点
        
        
                shOCHFA10.Cells(A_start_30mm - 1, 6) = SFR_Text(9)		'行数A_start_30mm - 1是因为上述循环+1行
            
                shOCHFA10.Cells(A_start_30mm - 1, 2) = Right(Left(LineText, 20), 19)
            Else
        
            End If
        End If
    
    Loop
     
    sFile.Close 	'关闭名为sFile的TextStream对象
    
    Set fso = Nothing	'对象变量关闭后，需要将对象变量设置为空
    
    Set sFile = Nothing		'对象变量关闭后，需要将对象变量设置为空
    
    Call Min_Avg		'调用Min_Avg子程序
    
    shOCHFA10.Cells(A_start_30mm, 1).Select
    
    Application.Calculation = xlCalculationAutomatic		'计算模式为自动，与开始设为手动成对存在，加快代码运行速度	

    Application.ScreenUpdating = True		'禁止屏幕刷新，与开始禁止刷屏成对存在，加快代码运行速度

    
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'这部分代码是求取多组数据的平均值和最小值
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Sub Min_Avg()

    Bookfile = ThisWorkbook.Name
         
    Set shOCHFA10 = Workbooks(Bookfile).Sheets("OCHFA10")
    
    Set sh_Start = Workbooks(Bookfile).Sheets("Start")

    
    shOCHFA10.Activate

    i = 0
    Run_done = 0
    Run_No = 0
    
    Do While shOCHFA10.Cells(i + 4, 3) <> ""
        i = i + 1
    Loop
    

    Do While shOCHFA10.Cells(Run_done + 4, 64) <> ""
        Run_done = Run_done + 1
    Loop
    
    Run_No = i - Run_done		'确定已经读取到目标数据但是未求平均值和最小值的行数
    
    
    
    Sum_x = 0
    Sum_y = 0
    Min_x = 1
    Min_y = 1
    Field_i = 0
    Field_j = 0
    
    For j = 0 To Run_No - 1
        
            For p = 0 To 6
                For q = 0 To 51
                    If shOCHFA10.Cells(1, q + 12) = shOCHFA10.Cells(1, p + 64) Then		'判断是都是目标字符串
                    
                        Field_i = Field_i + 1
                        Sum_x = Sum_x + shOCHFA10.Cells(Run_done + j + 4, q + 12)		'求和
                        
                            If shOCHFA10.Cells(Run_done + j + 4, q + 12) < Min_x Then	'迭代的方式求最小值
                                Min_x = shOCHFA10.Cells(Run_done + j + 4, q + 12)
                                
                            Else
                            
                        
                            End If
            
                    End If
                    
                    If shOCHFA10.Cells(1, q + 86) = shOCHFA10.Cells(1, p + 138) Then	'判断是都是目标字符串
                    
                       Field_j = Field_j + 1
                       Sum_y = Sum_y + shOCHFA10.Cells(Run_done + j + 4, q + 86)		'求和
                    
                           If shOCHFA10.Cells(Run_done + j + 4, q + 86) < Min_y Then	'迭代的方式求最小值
                                Min_y = shOCHFA10.Cells(Run_done + j + 4, q + 86)
                                
                           Else
                           End If
                    End If
                Next q
                
                If Field_i <> 0 Then
                    shOCHFA10.Cells(Run_done + j + 4, p + 64) = Min_x		'最小值写入单元格
                    shOCHFA10.Cells(Run_done + j + 4, p + 64 + 7) = Sum_x / Field_i		'求第一组数据的每项平均值
                End If
                    
                If Field_j <> 0 Then
                    shOCHFA10.Cells(Run_done + j + 4, p + 138) = Min_y		'最小值写入单元格
                    shOCHFA10.Cells(Run_done + j + 4, p + 138 + 7) = Sum_y / Field_j		'求第二组数据的每项平均值
                Else
                    
                End If
                    
                Sum_x = 0		'重置变量
                Sum_y = 0
                Field_i = 0
                Field_j = 0
                Min_x = 1
                Min_y = 1
            
                If shOCHFA10.Cells(Run_done + j + 4, 71 + p) <> 0 Then
                    shOCHFA10.Cells(Run_done + j + 4, 71 + p + 7) = shOCHFA10.Cells(Run_done + j + 4, 64 + p) / shOCHFA10.Cells(Run_done + j + 4, 71 + p)		'求同类两组值的比值
                Else
                    shOCHFA10.Cells(Run_done + j + 4, 71 + p + 7) = ""
                End If
                
                If shOCHFA10.Cells(Run_done + j + 4, 145 + p) <> 0 Then
                    shOCHFA10.Cells(Run_done + j + 4, 145 + p + 7) = shOCHFA10.Cells(Run_done + j + 4, 138 + p) / shOCHFA10.Cells(Run_done + j + 4, 145 + p)	'求同类两组值的比值
                Else
                    shOCHFA10.Cells(Run_done + j + 4, 145 + p + 7) = ""
                End If
                
            Next p
'            If shOCHTA10.Cells(Run_done + j + 4, 49) <> 0 Then
'                shOCHTA10.Cells(Run_done + j + 4, 53) = shOCHTA10.Cells(Run_done + j + 4, 45) / shOCHTA10.Cells(Run_done + j + 4, 49)
'                Else
'                shOCHTA10.Cells(Run_done + j + 4, 53) = ""
'
'            End If
'
'            If shOCHTA10.Cells(Run_done + j + 4, 50) <> 0 Then
'                shOCHTA10.Cells(Run_done + j + 4, 54) = shOCHTA10.Cells(Run_done + j + 4, 46) / shOCHTA10.Cells(Run_done + j + 4, 50)
'                Else
'                shOCHTA10.Cells(Run_done + j + 4, 54) = ""
'            End If
'
            
'            If shOCHTA10.Cells(Run_done + j + 4, 109) <> 0 Then
'                shOCHTA10.Cells(Run_done + j + 4, 113) = shOCHTA10.Cells(Run_done + j + 4, 108) / shOCHTA10.Cells(Run_done + j + 4, 109)
'                Else
'                shOCHTA10.Cells(Run_done + j + 4, 113) = ""
'            End If
'
'            If shOCHTA10.Cells(Run_done + j + 4, 105) <> 0 Then
'                shOCHTA10.Cells(Run_done + j + 4, 114) = shOCHTA10.Cells(Run_done + j + 4, 109) / shOCHTA10.Cells(Run_done + j + 4, 105)
'                shOCHTA10.Cells(Run_done + j + 4, 115) = shOCHTA10.Cells(Run_done + j + 4, 106) / shOCHTA10.Cells(Run_done + j + 4, 105)
'                Else
'                shOCHTA10.Cells(Run_done + j + 4, 114) = ""
'                shOCHTA10.Cells(Run_done + j + 4, 115) = ""
'
'            End If
'
'            If shOCHTA10.Cells(Run_done + j + 4, 106) <> 0 Then
'                shOCHTA10.Cells(Run_done + j + 4, 116) = shOCHTA10.Cells(Run_done + j + 4, 109) / shOCHTA10.Cells(Run_done + j + 4, 106)
'                Else
'                shOCHTA10.Cells(Run_done + j + 4, 116) = ""
'            End If
             
            
    Next j
    
'-------------------------------------------------------------------- To get 0.58F Min SFR and Avg SFR --------------------------------------------------------------------

'    Field58_Min = 1
'    Field58_Med = 1
'
'    For m = 0 To Run_No - 1
'        For n = 0 To 2
'
'            If shOCHTA10.Cells(Run_done + m + 4, n + 46) < Field58_Min Then
'                Field58_Min = shOCHTA10.Cells(Run_done + m + 4, n + 46)
'                Else
'            End If
'
'            If shOCHTA10.Cells(Run_done + m + 4, n + 101) < Field58_Med Then
'                Field58_Med = shOCHTA10.Cells(Run_done + m + 4, n + 101)
'                Else
'            End If
'
'        Next n
'
'        shOCHTA10.Cells(Run_done + m + 4, 45) = Field58_Min
'        shOCHTA10.Cells(Run_done + m + 4, 52) = (shOCHTA10.Cells(Run_done + m + 4, 53) * 8 + shOCHTA10.Cells(Run_done + m + 4, 54) * 4 + shOCHTA10.Cells(Run_done + m + 4, 55) * 8) / 20   '?????
'        shOCHTA10.Cells(Run_done + m + 4, 100) = Field58_Med
'        shOCHTA10.Cells(Run_done + m + 4, 107) = (shOCHTA10.Cells(Run_done + m + 4, 108) * 8 + shOCHTA10.Cells(Run_done + m + 4, 109) * 4 + shOCHTA10.Cells(Run_done + m + 4, 110) * 8) / 20   '?????
'
'        Field58_Min = 1
'        Field58_Med = 1
'
'    Next m
      
    
'-------------------------------------------------------------------- To Change Color for Fail items --------------------------------------------------------------------
    
    For m = 0 To Run_No - 1
        For n = 0 To 65
            
            If shOCHFA10.Cells(Run_done + m + 4, n + 12) < shOCHFA10.Cells(3, n + 12) Then		'判断获取的目标值是否小于规格，小于规则则标红，字体加粗，斜体
            
                shOCHFA10.Cells(Run_done + m + 4, n + 12).Font.ColorIndex = 3
                shOCHFA10.Cells(Run_done + m + 4, n + 12).Font.Bold = True
                shOCHFA10.Cells(Run_done + m + 4, n + 12).Font.Italic = True
                
            End If
            
            If shOCHFA10.Cells(Run_done + m + 4, n + 86) < shOCHFA10.Cells(3, n + 86) Then
            
                shOCHFA10.Cells(Run_done + m + 4, n + 86).Font.ColorIndex = 3
                shOCHFA10.Cells(Run_done + m + 4, n + 86).Font.Bold = True
                shOCHFA10.Cells(Run_done + m + 4, n + 86).Font.Italic = True
                
            
            End If
            
        Next n
    Next m
    
    
'-------------------------------------------------------------------- To delete repeated rows and empty rows --------------------------------------------------------------------
    
    For m = 0 To Run_No - 1

'        If shOCHFA10.Cells(Run_done + m + 4, 5) <> "" And shOCHFA10.Cells(Run_done + m + 4, 12) = "" Then
         If shOCHFA10.Cells(Run_done + m + 4, 6) <> 0 And Application.CountIf(shOCHFA10.Columns("E"), shOCHFA10.Cells(Run_done + m + 4, 5)) > 1 or shOCHFA10.Cells(Run_done + m + 4, 6) <> 0 And shOCHFA10.Cells(Run_done + m + 4, 12) = "" Then
            Rows(Run_done + m + 4).Delete
            m = m - 1
            Else
        End If
    Next m
'   
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'这部分代码是汇总数据，按照同一群数据进行求和，分类，取平均值，算两群数据比值
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

Sub MTSummary()
    Bookfile = ThisWorkbook.Name
    Set shData = Workbooks(Bookfile).Sheets("MT Summary")
    
    Dim arr
    Dim dataArr
    startRow = shData.Range("Y100000").End(xlUp).Row + 1
    endRow = shData.Range("D100000").End(xlUp).Row
    
    Set shOpenSummary = ThisWorkbook.Sheets("OCHFA10")
    On Error Resume Next
    shOpenSummary.ShowAllData
    dataLastRow = shOpenSummary.Range("C1000000").End(xlUp).Row
    dataArr = shOpenSummary.Range("C5:FB" & dataLastRow)
     
    For i = startRow To endRow
        lotID = shData.Cells(i, 4).Value
        
        CenterShift = 0
        
        RatioDiagTL = 0
        RatioDiagTR = 0
        RatioDiagBL = 0
        RatioDiagBR = 0
        
        OD5mm01FMin = 0
        OD5mm028FMin = 0
        OD5mm036FMin = 0
        OD5mm041FMin = 0
        OD5mm048FMin = 0
        OD5mm061FMin = 0
        OD5mm072FMin = 0
        
        OD5mm01FAvg = 0
        OD5mm028FAvg = 0
        OD5mm036FAvg = 0
        OD5mm041FAvg = 0
        OD5mm048FAvg = 0
        OD5mm061FAvg = 0
        OD5mm072FAvg = 0
        
        OD5mm01FRatio = 0
        OD5mm028FRatio = 0
        OD5mm036FRatio = 0
        OD5mm041FRatio = 0
        OD5mm048FRatio = 0
        OD5mm061FRatio = 0
        OD5mm072FRatio = 0
        
        OD50mm01FMin = 0
        OD50mm028FMin = 0
        OD50mm036FMin = 0
        OD50mm041FMin = 0
        OD50mm048FMin = 0
        OD50mm061FMin = 0
        OD50mm072FMin = 0
        
        OD50mm01FAvg = 0
        OD50mm028FAvg = 0
        OD50mm036FAvg = 0
        OD50mm041FAvg = 0
        OD50mm048FAvg = 0
        OD50mm061FAvg = 0
        OD50mm072FAvg = 0

        OD50mm01FRatio = 0
        OD50mm028FRatio = 0
        OD50mm036FRatio = 0
        OD50mm041FRatio = 0
        OD50mm048FRatio = 0
        OD50mm061FRatio = 0
        OD50mm072FRatio = 0
        
        Bin_0 = 0
        Bin_325 = 0
        Bin_202_203 = 0
        Bin_385 = 0
        Bin_315 = 0
        Bin_365 = 0
        Bin_other = 0
        
        unitCount = 0
        For j = 1 To dataLastRow - 4
            If dataArr(j, 1) = lotID And dataArr(j, 10) <> "" Then
                'lastDate = dataArr(j, 1)
                RatioDiagTL = RatioDiagTL + dataArr(j, 5)
                RatioDiagTR = RatioDiagTR + dataArr(j, 6)
                RatioDiagBL = RatioDiagBL + dataArr(j, 7)
                RatioDiagBR = RatioDiagBR + dataArr(j, 8)
                
                CenterShift = CenterShift + dataArr(j, 9)
                
                OD5mm01FMin = OD5mm01FMin + dataArr(j, 136)
                OD5mm028FMin = OD5mm028FMin + dataArr(j, 137)
                OD5mm036FMin = OD5mm036FMin + dataArr(j, 138)
                OD5mm041FMin = OD5mm041FMin + dataArr(j, 139)
                OD5mm048FMin = OD5mm048FMin + dataArr(j, 140)
                OD5mm061FMin = OD5mm061FMin + dataArr(j, 141)
                OD5mm072FMin = OD5mm072FMin + dataArr(j, 142)
                
                OD5mm01FAvg = OD5mm01FAvg + dataArr(j, 143)
                OD5mm028FAvg = OD5mm028FAvg + dataArr(j, 144)
                OD5mm036FAvg = OD5mm036FAvg + dataArr(j, 145)
                OD5mm041FAvg = OD5mm041FAvg + dataArr(j, 146)
                OD5mm048FAvg = OD5mm048FAvg + dataArr(j, 147)
                OD5mm061FAvg = OD5mm061FAvg + dataArr(j, 148)
                OD5mm072FAvg = OD5mm072FAvg + dataArr(j, 149)
                
                OD5mm01FRatio = OD5mm01FRatio + dataArr(j, 150)
                OD5mm028FRatio = OD5mm028FRatio + dataArr(j, 151)
                OD5mm036FRatio = OD5mm036FRatio + dataArr(j, 152)
                OD5mm041FRatio = OD5mm041FRatio + dataArr(j, 153)
                OD5mm048FRatio = OD5mm048FRatio + dataArr(j, 154)
                OD5mm061FRatio = OD5mm061FRatio + dataArr(j, 155)
                OD5mm072FRatio = OD5mm072FRatio + dataArr(j, 156)
                    
                OD50mm01FMin = OD50mm01FMin + dataArr(j, 62)
                OD50mm028FMin = OD50mm028FMin + dataArr(j, 63)
                OD50mm036FMin = OD50mm036FMin + dataArr(j, 64)
                OD50mm041FMin = OD50mm041FMin + dataArr(j, 65)
                OD50mm048FMin = OD50mm048FMin + dataArr(j, 66)
                OD50mm061FMin = OD50mm061FMin + dataArr(j, 67)
                OD50mm072FMin = OD50mm072FMin + dataArr(j, 68)
                
                OD50mm01FAvg = OD50mm01FAvg + dataArr(j, 69)
                OD50mm028FAvg = OD50mm028FAvg + dataArr(j, 70)
                OD50mm036FAvg = OD50mm036FAvg + dataArr(j, 71)
                OD50mm041FAvg = OD50mm041FAvg + dataArr(j, 72)
                OD50mm048FAvg = OD50mm048FAvg + dataArr(j, 73)
                OD50mm061FAvg = OD50mm061FAvg + dataArr(j, 74)
                OD50mm072FAvg = OD50mm072FAvg + dataArr(j, 75)
                
                OD50mm01FRatio = OD50mm01FRatio + dataArr(j, 76)
                OD50mm028FRatio = OD50mm028FRatio + dataArr(j, 77)
                OD50mm036FRatio = OD50mm036FRatio + dataArr(j, 78)
                OD50mm041FRatio = OD50mm041FRatio + dataArr(j, 79)
                OD50mm048FRatio = OD50mm048FRatio + dataArr(j, 80)
                OD50mm061FRatio = OD50mm061FRatio + dataArr(j, 81)
                OD50mm072FRatio = OD50mm072FRatio + dataArr(j, 82)
                      
                unitCount = unitCount + 1
                
                If dataArr(j, 4) = 0 Then
                    Bin_0 = Bin_0 + 1
                ElseIf dataArr(j, 4) = 325 Then
                    Bin_325 = Bin_325 + 1
                ElseIf dataArr(j, 4) = 202 Or dataArr(j, 4) = 203 Then
                    Bin_202_203 = Bin_202_203 + 1
                ElseIf dataArr(j, 4) = 385 Then
                    Bin_385 = Bin_385 + 1
                ElseIf dataArr(j, 4) = 315 Then
                    Bin_315 = Bin_315 + 1
                ElseIf dataArr(j, 4) = 365 Then
                    Bin_365 = Bin_365 + 1
                Else
                    Bin_other = Bin_other + 1
                End If
                
            End If
        Next
    
        shData.Cells(i, "V").Value = CenterShift / unitCount
    
        shData.Cells(i, "W").Value = RatioDiagTL / unitCount
        shData.Cells(i, "X").Value = RatioDiagTR / unitCount
        shData.Cells(i, "Y").Value = RatioDiagBL / unitCount
        shData.Cells(i, "Z").Value = RatioDiagBR / unitCount
        
        shData.Cells(i, "AA").Value = OD5mm01FMin / unitCount
        shData.Cells(i, "AB").Value = OD5mm028FMin / unitCount
        shData.Cells(i, "AC").Value = OD5mm036FMin / unitCount
        shData.Cells(i, "AD").Value = OD5mm041FMin / unitCount
        shData.Cells(i, "AE").Value = OD5mm048FMin / unitCount
        shData.Cells(i, "AF").Value = OD5mm061FMin / unitCount
        shData.Cells(i, "AG").Value = OD5mm072FMin / unitCount
        
        shData.Cells(i, "AH").Value = OD5mm01FAvg / unitCount
        shData.Cells(i, "AI").Value = OD5mm028FAvg / unitCount
        shData.Cells(i, "AJ").Value = OD5mm036FAvg / unitCount
        shData.Cells(i, "AK").Value = OD5mm041FAvg / unitCount
        shData.Cells(i, "AL").Value = OD5mm048FAvg / unitCount
        shData.Cells(i, "AM").Value = OD5mm061FAvg / unitCount
        shData.Cells(i, "AN").Value = OD5mm072FAvg / unitCount
        
        shData.Cells(i, "AO").Value = OD5mm01FRatio / unitCount
        shData.Cells(i, "AP").Value = OD5mm028FRatio / unitCount
        shData.Cells(i, "AQ").Value = OD5mm036FRatio / unitCount
        shData.Cells(i, "AR").Value = OD5mm041FRatio / unitCount
        shData.Cells(i, "AS").Value = OD5mm048FRatio / unitCount
        shData.Cells(i, "AT").Value = OD5mm061FRatio / unitCount
        shData.Cells(i, "AU").Value = OD5mm072FRatio / unitCount
        
        
        shData.Cells(i, "AV").Value = OD50mm01FMin / unitCount
        shData.Cells(i, "AW").Value = OD50mm028FMin / unitCount
        shData.Cells(i, "AX").Value = OD50mm036FMin / unitCount
        shData.Cells(i, "AY").Value = OD50mm041FMin / unitCount
        shData.Cells(i, "AZ").Value = OD50mm048FMin / unitCount
        shData.Cells(i, "BA").Value = OD50mm061FMin / unitCount
        shData.Cells(i, "BB").Value = OD50mm072FMin / unitCount
        
        
        shData.Cells(i, "BC").Value = OD50mm01FAvg / unitCount
        shData.Cells(i, "BD").Value = OD50mm028FAvg / unitCount
        shData.Cells(i, "BE").Value = OD50mm036FAvg / unitCount
        shData.Cells(i, "BF").Value = OD50mm041FAvg / unitCount
        shData.Cells(i, "BG").Value = OD50mm048FAvg / unitCount
        shData.Cells(i, "BH").Value = OD50mm061FAvg / unitCount
        shData.Cells(i, "BI").Value = OD50mm072FAvg / unitCount
        
        
        shData.Cells(i, "BJ").Value = OD50mm01FRatio / unitCount
        shData.Cells(i, "BK").Value = OD50mm028FRatio / unitCount
        shData.Cells(i, "BL").Value = OD50mm036FRatio / unitCount
        shData.Cells(i, "BM").Value = OD50mm041FRatio / unitCount
        shData.Cells(i, "BN").Value = OD50mm048FRatio / unitCount
        shData.Cells(i, "BO").Value = OD50mm061FRatio / unitCount
        shData.Cells(i, "BP").Value = OD50mm072FRatio / unitCount
        
        shData.Cells(i, "A").Value = "ATE"
        shData.Cells(i, "B").Value = "OCHFA10"
        shData.Cells(i, "C").Value = Format(Now, "yyyy/mm/dd")
        shData.Cells(i, "E").Value = unitCount
        shData.Cells(i, "O").Value = Bin_0
        shData.Cells(i, "P").Value = Bin_325
        shData.Cells(i, "Q").Value = Bin_202_203
        shData.Cells(i, "R").Value = Bin_385
        shData.Cells(i, "S").Value = Bin_315
        shData.Cells(i, "T").Value = Bin_365
        shData.Cells(i, "U").Value = Bin_other


'        If shData.Cells(i, "AG").Value < shData.Cells(3, "AG").Value Then
'            shData.Range("AG" & i).Font.Color = vbRed
'            shData.Range("AG" & i).Font.Bold = True
'        Else:
'            shData.Range("AG" & i).Font.Color = vbBlack
'            shData.Range("AG" & i).Font.Bold = False
'        End If
'        If shData.Cells(i, "O").Value < 0.24 Then
'            shData.Range("O" & i).Font.Color = vbRed
'            shData.Range("O" & i).Font.Bold = True
'        Else:
'            shData.Range("O" & i).Font.Color = vbBlack
'            shData.Range("O" & i).Font.Bold = False
'        End If
'        If shData.Cells(i, "AC").Value < shData.Cells(3, "AC").Value Then
'            shData.Range("AC" & i).Font.Color = vbRed
'            shData.Range("AC" & i).Font.Bold = True
'        Else:
'            shData.Range("AC" & i).Font.Color = vbBlack
'            shData.Range("AC" & i).Font.Bold = False
'        End If
'
    Next
    

    For k_i = 1 To 7
        If shData.Cells(i - 1, 5) <> "" Then
            shData.Cells(i - 1, 5 + k_i) = shData.Cells(i - 1, 14 + k_i) / shData.Cells(i - 1, 5)
        End If
    
    Next
    
    Workbooks(summaryFile).Close SaveChanges:=False
    
End Sub

以上代码中，可以总结几个重点技巧：

1.vba读取txt文档并逐行读取字符串，利用split等方法提取特定的字符串；
2.定向标识，当读取内容行的字符串有多行无法区别，则采用跨行找可识别的行，并作为识别标识，如上代码中的例子；

        If LineText_TVL = "(210)" Then     '定向标识，当读取内容行的字节无法区别，则采用跨行识别
            Light_i = 1
        End If
        
        If LineText_TVL = "(70)" Then      '定向标识
            Light_j = 1
        End If

3.采用一维数组（二维数组）读取目标字符串，再将目标字符串一次性写入单元格，快速高效，可以提高代码运行速度；
4.处理数据时多组织的平均值和最小值，尤其是最小值的取法。

Script_Man

关注

13
点赞
踩
8

收藏

觉得还不错? 一键收藏
0
评论
VBA批量读取txt文档目标数据并分组处理

VBA在批量处理txt等文本文件的数据是其数据处理的一大重要应用，实际在处理txt文档往往需要提取多个测试料的多个目标数值，而且还要将提取的数值进一步处理，如求取平均值，最小值等，能够直观地看到一组数据的规律；将超出规格的数据进行标识，可以直观看到某些数据异常区域。
复制链接

扫一扫

专栏目录