vb 遍历sheet名和对数据循环处理并输出到文件

来源:互联网 发布:boss 弹道优化瞄准镜 编辑:程序博客网 时间:2024/06/06 06:58

实现对工作簿中的工作表标签匹配,并对其中的数据进行加工处理,用到了循环遍历,及文件输出

Dim MyPathSub ClickThere()'   得到当前活动工作簿的根目录    MyPath = ActiveWorkbook.Path & "\"    Close #1'   打开文件    Open MyPath & "test.txt" For Output As #1'   填充数据'    Call FillNum("ADS")'    Call FillNum("SDS")'    Call FillNum("RDM")    Dim sh1 As Worksheet'   匹配工作表名并调用对应sub    For i = 1 To Workbooks(1).Worksheets.Count        Workbooks(1).Activate        Set sh1 = ActiveWorkbook.Worksheets(i)        sh1.Activate        sheetName = sh1.Name        If sheetName = "OPT" Then            Call OptionSub        ElseIf sheetName = "FTP" Then            Call FTPSub        ElseIf sheetName = "ODS" Then            Call ODSSub        ElseIf sheetName = "DDS" Then            Call DDSSub        ElseIf sheetName = "ADS" Then            Call ADSSub        ElseIf sheetName = "SDS" Then            Call SDSSub        ElseIf sheetName = "RDM" Then            Call RDMSub        End If    Next i    Close #1End Sub'遍历工作表中的数据,并输出到文件Sub OptionSub()    Dim OPTNum As Integer'   得到有效数据行    OPTNum = Sheets("OPT").[B65536].End(xlUp).Row'   循环控制,读取单元格数据    For i = 1 To OPTNum        S = Sheets("OPT").Range("B" & i).Text        Print #1, S    Next iEnd SubSub FTPSub()    Dim FTPnum As Integer    FTPnum = Sheets("FTP").[B65536].End(xlUp).Row'    taskname,D,10,FTP,,ftpdownload,taskdely    Print #1, "###FTP层"    For i = 2 To FTPnum        taskName = Sheets("FTP").Range("B" & i).Text        taskRely = Sheets("FTP").Range("C" & i).Text        taskCycle = Sheets("FTP").Range("D" & i).Text'       设置默认值        If Len(Trim(taskCycle)) = 0 Then            taskCycle = "D"        End If        Print #1, taskName & "," & taskCycle & ",10,FTP,,ftpdownload," & taskRely    Next iEnd SubSub ODSSub()    Dim ODSnum As Integer    ODSnum = Sheets("ODS").[B65536].End(xlUp).Row'   taskName,D,9,ODS,taskRely,olload,taskRely    Print #1, "###ODS层"    For i = 2 To ODSnum        taskName = Sheets("ODS").Range("B" & i).Text        taskRely = Sheets("ODS").Range("C" & i).Text        taskCycle = Sheets("ODS").Range("D" & i).Text        If Len(Trim(taskCycle)) = 0 Then            taskCycle = "D"        End If        Print #1, taskName & "," & taskCycle & ",9,ODS," & taskRely & ",olload," & taskRely    Next iEnd SubSub DDSSub()    Dim DDSNum, ADSNum As Integer    Dim j As Integer    DDSNum = Sheets("DDS").[B65536].End(xlUp).Row    ADSNum = Sheets("ADS").[B65536].End(xlUp).Row'   taskName,D,8,DDS,taskRely,olcall,    Print #1, "###DDS层"    For i = 2 To DDSNum        taskName = Sheets("DDS").Range("B" & i).Text        taskRely = Sheets("DDS").Range("C" & i).Text        taskCycle = Sheets("DDS").Range("D" & i).Text        If Len(Trim(taskCycle)) = 0 Then            taskCycle = "D"        End If        ADSRely = ""        For j = 2 To ADSNum            ADSTN = Sheets("ADS").Range("C" & j).Text            If taskName = ADSTN Then                ADSTag = SelectNum("ADS", j)                ADSRely = ADSRely & "|ADS" & ADSTag            End If        Next j        Print #1, taskName & "," & taskCycle & ",8,DDS" & ADSRely; "," & taskRely & ",olcall,"    Next iEnd SubSub ADSSub()    Dim ADSNum, SDSNum, RDMNum As Integer    Dim i As Integer    Dim j As Integer    Dim k As Integer    Dim l As Integer    ADSNum = Sheets("ADS").[B65536].End(xlUp).Row    SDSNum = Sheets("SDS").[B65536].End(xlUp).Row    RDMNum = Sheets("RDM").[B65536].End(xlUp).Row'   taskName,D,7,ADS,taskRely,olcall,    Print #1, "###ADS层"    ADSFlag = ""    For i = 2 To ADSNum        taskName = Sheets("ADS").Range("B" & i).Text        taskCycle = Sheets("ADS").Range("D" & i).Text        taskTagNum = SelectNum("ADS", i)        If Len(Trim(taskCycle)) = 0 Then            taskCycle = "D"        End If        If ADSFlag <> taskName Then            ADSRely = ""            For j = 2 To ADSNum                ADSTN = Sheets("ADS").Range("C" & j).Text                If taskName = ADSTN Then                    ADSTag = SelectNum("ADS", j)                    ADSRely = ADSRely & "|ADS" & ADSTag                End If            Next j            For k = 2 To SDSNum                SDSTN = Sheets("SDS").Range("C" & k).Text                If taskName = SDSTN Then                    SDSTag = SelectNum("SDS", k)                    ADSRely = ADSRely & "|SDS" & SDSTag                End If            Next k            For l = 2 To RDMNum                RDMTN = Sheets("RDM").Range("C" & l).Text                If taskName = RDMTN Then                    RDMTag = SelectNum("RDM", l)                    ADSRely = ADSRely & "|RDM" & RDMTag                End If            Next l            Print #1, taskName & "," & taskCycle & ",7,ADS" & ADSRely; ",@ADS" & taskTagNum & ",olload,"        End If        ADSFlag = taskName    Next iEnd SubSub SDSSub()    Dim SDSNum, RDSNum As Integer    Dim i As Integer    Dim j As Integer    Dim k As Integer    SDSNum = Sheets("SDS").[B65536].End(xlUp).Row    RDMNum = Sheets("RDM").[B65536].End(xlUp).Row'   taskName,D,6,SDS,taskRely,olcall,    Print #1, "###SDS层"    SDSFlag = ""    For i = 2 To SDSNum        taskName = Sheets("SDS").Range("B" & i).Text        taskCycle = Sheets("SDS").Range("D" & i).Text        taskTagNum = SelectNum("SDS", i)        If Len(Trim(taskCycle)) = 0 Then            taskCycle = "D"        End If        If SDSFlag <> taskName Then            SDSRely = ""            For j = 2 To SDSNum                SDSTN = Sheets("SDS").Range("C" & j).Text                If taskName = SDSTN Then                    SDSTag = SelectNum("SDS", j)                    SDSRely = SDSRely & "|SDS" & SDSTag                End If            Next j            For k = 2 To RDMNum                RDMTN = Sheets("RDM").Range("C" & k).Text                If taskName = RDMTN Then                    RDMTag = SelectNum("RDM", k)                    SDSRely = SDSRely & "|RDM" & RDMTag                End If            Next k            Print #1, taskName & "," & taskCycle & ",6,SDS" & SDSRely; ",@SDS" & taskTagNum & ",olcall,"        End If        SDSFlag = taskName    Next iEnd SubSub RDMSub()    Dim RDMNum As Integer    Dim i As Integer    RDMNum = Sheets("RDM").[B65536].End(xlUp).Row'   taskName,D,5,RDM,taskRely,olload,taskRely    Print #1, "###RDM层"    RDMFlag = ""    For i = 2 To RDMNum        taskName = Sheets("RDM").Range("B" & i).Text        taskCycle = Sheets("RDM").Range("D" & i).Text        taskTagNum = SelectNum("RDM", i)        If Len(Trim(taskCycle)) = 0 Then            taskCycle = "D"        End If        If RDMFlag <> taskName Then            Print #1, taskName & "," & taskCycle & ",5,RDM,@RDM" & taskTagNum & ",olcall,"        End If        RDMFlag = taskName    Next iEnd SubSub FillNum(sheetName As String)    Dim num As Integer    totalNum = Sheets(sheetName).[B65536].End(xlUp).Row    flag = Sheets(sheetName).Range("B2").Text    Sheets(sheetName).Range("e1") = "标签序列"    num = 1    For i = 2 To totalNum        taskName = Sheets(sheetName).Range("B" & i).Text        If flag <> taskName Then            num = num + 1        End If        flag = taskName        Sheets(sheetName).Range("e" & i) = num    Next iEnd SubSub test()    t = SelectNum("RDM", 12)    MsgBox tEnd SubFunction SelectNum(sheetName As String, totalNum As Integer)    flag = Sheets(sheetName).Range("B2").Text    num = 1    For i = 2 To totalNum        taskName = Sheets(sheetName).Range("B" & i).Text        If flag <> taskName Then            num = num + 1        End If        flag = taskName    Next i    SelectNum = numEnd Function
0 0
原创粉丝点击