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

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

Dim MyPath
Sub 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 #1
End 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 i
End Sub
Sub 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 i
End Sub
Sub 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 i
End Sub
Sub 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 i
End Sub
Sub 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 i
End Sub
Sub 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 i
End Sub
Sub 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 i
End Sub

Sub 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 i
End Sub

Sub test()
    t = SelectNum("RDM", 12)
    MsgBox t
End Sub
Function 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 = num
End Function